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Introduction 


The  ESM  system  software  is  contained  on  four  TU10  Magtapes. 

^Tape  4l  contains  the  source,  object,  task,  overlay  description 
language,  message,  system,  ATEC  simulation,  and  command  files  used 
for  the  User  Language,  Record  Move  Utility,  and  Interprocess 
Communication  and  Resource  Shari/ig  Demonstration  Programs  for 
host  processors  A and  B.  Tape  42  contains  microcode  source  and 
object  files  for  loading  the  eleven  B7*  CIE  microprocessors,  and 
the  microcode  loader  utility • tESMLDR) . * Tape  42  contains  the 
task,  source,  object,  and  overlay  description  language  files  for  c 
the  Mini-D  Micro  Programming  Language  (MDMPL)-'  Assembler . Tape  -#4 
contains  the  ESM  Diagnostic  Library. 


References  for  the  FORTRAN  language  used  include  the  Digital 
Equipment  Corporation  documents  PDP-11  FORTRAN  Language  Reference 
Manual  (DEC-ll-CFLRA-C-D)  and  IAS/RSX-11  FORTRAN  IV  User's  Guide 
(DEC-ll-LMFUA-C-D) . It  is  also  assumed  that  the  reader  is 
familiar  with  the  PDP-11  RSX11M  operating  system  (Version  2) 
including  MCR  commands  (Reference  - RSX11M  Operator's  Procedures 
Manual  - DEC-11-OM06A-B-D)  and  the  utilities  EDI,  FLX , and  PIP 
(Reference  - RSXllM  Utilities  Procedures  Manual  - DEC-11-0M0GA- 
B-D)  . 


References  for  the  MDMPL  Assembler  include  Appendix  A of  this 
manual  which  provides  B7*  programming  information,  Appendix  B of 
the  manual  which  provides  an  MDMPL  Instruction  List,  and  Section 
4.6  of  the  ESM  User's  Manual  which  describes  Assembler  use,  CIE 
Instruction  Functions,  and  programming  examples. 

In  general,  FORTRAN  programs  are  stored  in  UIC  [20,20],  CIE 
Microcode  programs  are  stored  in  UIC [1,20],  and  Diagnostics  are 
stored  in  UIC[1,4].  System  Tape  Directory  Listings  are  presented 
below. 
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Burroughs  Corporation 


ESN  TAPE  *1  - USER  LANGUAGE 


HCR>PLX  TT0t=MT0:[*,*3*.*/LI 


DIRECTORY 

MTorco.oa 

1B-MAR-77 

RCMV1 .FOR 

V. 

18-MAR-77 

<233> 

[20,203 

RCMV1.0BJ 

22. 

18-MAR-77 

<233> 

[20,203 

RCNVI.ODL 

1. 

1 8-MAR-77 

<233> 

[ 20  , 203 

RCMV1.TSK 

53. 

10-MAR-77 

<233> 

[20.203 

RCMV5.0DL 

1. 

18-MAR-77 

<233> 

C 20 . 203 

RCMV5.F0R 

9. 

18-MAR-77 

<233> 

[20.203 

RCMV5.TSK 

53. 

18-MAR-77 

<233> 

[20  > 203 

RCMV5.0BJ 

22. 

18-MAR-77 

<233> 

C20.203 

PR0C1.TSK 

48. 

18-MAR-77 

<233> 

[20.203 

PR0C1.0BJ 

26. 

18-MAR-77 

<233> 

[20.203 

PR0C1.0DL 

1. 

18-MAR-77 

<23 3> 

[20.203 

PR0C1.F0R 

11. 

18-MAR-77 

<233> 

[20.203 

PR0C5.0BJ 

27. 

18-MAR-77 

<233> 

[20.203 

PR0C5.0BL 

1. 

18-MAR-77 

<233> 

[ 20.203 

PR0C5.TSN 

48. 

18-MAR-77 

<233> 

[20.203 

PR0C5.F0R 

11. 

18-MAR-77 

<233> 

[20.203 

M1710.FOR 

1. 

09-MAR-77 

<233> 

[ 20.203 

M1710.0BJ 

1. 

09-MAR-77 

<233> 

[20.203 

N1710.TSK 

3. 

09-MAR-77 

<233> 

[1.13 

M1710.STB 

1. 

09-MAR-77 

<233> 

[1.13 

INFORM. OBJ 

67. 

09-MAR-77 

<233> 

[20.203 

MSP. OBJ 

36. 

09-MAR-77 

<233> 

[20.203 

EFTERD.OBJ 

9. 

09-MAR-7 7 

<233> 

[20.203 

EFCKTD.OBJ 

4. 

09-MAR-77 

<233> 

[20.203 

EFTRKD.OBJ 

4. 

09-MAR-77 

<233> 

[20.203 

EFLOCF .OBJ 

5. 

09-MAR-77 

<233> 

[20.203 

EFDIR.OBJ 

2. 

09-MAR-77 

<233> 

[20,203 

6TESM.CMD 

1. 

09-MAR-77 

<233> 

[20,203 

ESMLDR.TSK 

32. 

09-MAR-77 

<233> 

[20,203 

MDMPL.TSK 

86. 

09-MAR-77 

<233> 

[20,203 

USROVL.ODL 

1. 

09-MAR-77 

<233> 

[20,203 

POOOO.OBJ 

21. 

09-MAR-77 

<233> 

[20,203 

POOOO.FOR 

11. 

09-MAR-77 

<233> 

[20,203 

POOOOl .OBJ 

21. 

09-MAR-77 

<23  3> 

[20,203 

POOOOl • FOR 

11. 

09-MAR-77 

<233> 

[20,203 

PIOOO.FOR 

6. 

18-MAR-77 

<233> 

[20,203 

PIOOO.OBJ 

12. 

18-MAR-77 

<233> 

[20,203 

PIOOOl .FOR 

6. 

18-MAR-77 

<233> 

[20,203 

PIOOOl .OBJ 

12. 

18-MAR-77 

<233> 

120,203 

P2000.F0R 

5. 

18-MAR-77 

<233> 

[20,203 

P2000. OBJ 

11. 

18-MAR-77 

<233> 

[20,203 

P3000.F0R 

11. 

18-MAR-77 

<233> 

[20,203 

P3000.0BJ 

26. 

1 8-MAR-77 

<233> 

C20.203 

P300I . OBJ 

17. 

18-MAR-77 

<233> 

[20,203 

P3001 .FOR 

7. 

1 8-MAR-77 

<233> 

[20,203 

PA OOO .FOR 

13. 

18-MAR-77 

<233> 

[20,203 

P4000 . OBJ 

29. 

1 8-MAR-77 

<23 3 > 

[20,203 

P40001 .FOR 

13. 

18-MAR-77 

<233> 

[20,203 

P40001 .OBJ 

29. 

18 -MAR-77 

<233> 

1 20 ,20  3 

P4001 .FOR 

l'l  . 

18-MAR-77 

<23 3 > 

[20.203 

X 
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P5000.F0R 

4. 

18-MAR-77 

<233> 

[20,203 

P5000.0BJ 

8. 

1B-MAR-77 

<233> 

C20. 203 

RDLOOP.OBJ 

2. 

18-MAR-77 

<233> 

[20.203 

RDLOOP.FOR 

1. 

18-MAR-77 

<233> 

C20.203 

WRLOOP.FOR 

1. 

18-MAR-77 

<233> 

[20.203 

HRLOOP.OBJ 

2. 

18-MAR -77 

<233> 

[20.203 

HST.FOR 

4. 

18-MAR-77 

<233> 

[20.203 

HST.OBJ 

11. 

18-MAR-77 

<233> 

[20.203 

HST1.FOR 

4. 

18-MAR-77 

<233> 

[20.203 

HSTl.OBJ 

11. 

18-MAR-7 7 

<233> 

C20.203 

USRLN5.TSK 

98. 

18-MAR-77 

<233> 

[20.203 

USRLN1.TSK 

98. 

18-MAR-77 

<233> 

[20,203 

TOTAL  OF  1181. 

BLOCKS  IN  65. 

FILES 
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Burroughs  Corporation 


ESM  TAPE  *2  - CIE  MICROCODE 


MCRDFLX  TT1  :=MTO  :C  *,  + 3*.  */L  I 


DIRECTORY  MT0:C0,  03 

12-MAR-?? 


HSTl.  OBJ 

9. 

12-MAR-7? 

<233> 

1 1,  2o: 

GAT2.  OBJ 

8. 

12-MRR-7? 

<233> 

ci, 20: 

GAT3.  OBJ 

8. 

12-MAR-7? 

<233> 

c 1,  201 

CRT4. OBJ 

9 

12-MRR-7? 

<1233> 

Cl, 201 

HST5.  OBJ 

9. 

12-MAR-?? 

<233> 

C 1,  201 

GAT6.  OBJ 

8. 

12-MAR-7? 

<233> 

C 1,  20  I 

GAT?.  OBJ 

8. 

12-MAR-7? 

<233> 

c 1, 20: 

CRT8.  oej 

9. 

12-MAR-?? 

<233> 

C 1,  20  I 

HST9.  OBJ 

8. 

12-MAR-77 

<233> 

C 1,  20  ] 

GAT10.  OBJ 

8. 

12-MAR-?? 

<233> 

C 1,  20  3 

GRT11.  OBJ 

8.  ’ 

12-MAR-?? 

<233> 

C 1,  201 

HST1L.  OBJ 

9. 

12-MAR-?? 

<233> 

Cl,  203 

CRT4L.  OBJ 

9. 

12-MAR-?? 

<2333> 

C 1,  20  3 

HST5L. OBJ 

9. 

12-MAR-?? 

<233> 

C 1,  20  3 

CRTSL.  OBJ 

9. 

12-MAR-?? 

<233> 

C 1,  20  3 

CRT4S. OBJ 

9. 

12-MAR-?? 

<233> 

C 1,  203 

CRT8S.  OBJ 

9. 

12-MAR-?? 

<233> 

C 1,  20  3 

HST9S. OBJ 

8. 

12-MAR-7? 

<233> 

C 1,  20  3 

CRT4.  DAT 

119. 

12- MAR-7? 

<233> 

C 1,  20  3 

HST5. DAT 

100. 

12-MAR-?? 

<2333* 

C 1,  20  3 

GRT7.  DAT 

97. 

12-MAR-7? 

<233> 

C 1,  20  3 

HST9. DAT 

102. 

12-MAR-?? 

< 2 3 3 > 

C 1,  20  3 

ESMLDR.  FOR 

2. 

12-MAR-?? 

<233> 

C 20,  203 

ESMLDR.  OBJ 

5. 

12-MAR-?? 

< 2 3 3 > 

C 20,  20  3 

ESMLDR. TSK 

32. 

12-MAR-?? 

<233> 

C 20;  20  3 

MDMPL. TSK 

86. 

12-MAR-?? 

<233> 

C 20,  20  3 

TOTAL  OF  69 7. 

BLOCKS  IN  26. 

FILES 

> 
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ESrt  TAPE  #3  - MDMPL  ASSEMBLER 


I 


I 


FLX  -’CLO : =MTO : C20  > 20  J * . */L  I 


DIRECTORY 

26-FEB-77 


MT0SC20f20D 


FASS.ODL 

1. 

26-FEB-77 

<233> 

MDMLST.CMD 

1. 

26-FEB-77 

<233> 

SUSAN. FOR 

13. 

26-FEB-77 

<233> 

BLOCK. FOR 

3. 

26-FEB-77 

<233> 

RESCAN. FOR 

7. 

26-FEB-77 

<233> 

WRT.FOR 

9. 

26-FEB-77 

<233> 

SQUASH. FOR 

3. 

26-FEB-77 

<233> 

SCAN. FOR 

5. 

26-FEB-77 

<233> 

COLUMN. FOR 

7. 

26-FEB-77 

<233> 

CONDIT .FOR 

11. 

26-FEB-77 

<233> 

LITRL.FOR 

13. 

26-FEB-77 

<233> 

LOGIC. FOR 

16. 

26-FEB-77 

<233> 

LOOICA.FOR 

13. 

26-FEB-77 

<233> 

MDMPL. TSK 

86 . 

26-FEB-77 

<233> 

SUSAN. OBJ 

27. 

26-FEB-77 

<233> 

BLOCK. OBJ 

1. 

26-FEB-77 

<233> 

RESCAN. OBJ 

10. 

26-FEB-77 

<233> 

WRT.OB j 

11. 

26-FEB-77 

<233> 

SQUASH. OBJ 

3. 

26-FEB-77 

<233> 

SCAN. OBJ 

7. 

26-FEB-77 

<233> 

COLUMN. OBJ 

11. 

26-FEB-77 

<2"3> 

CONDIT. OBJ 

23. 

26-r EB-77 

<233> 

LITRL.OBJ 

23. 

26-FEB-77 

<233> 

LOGIC. OBJ 

38. 

26-FEB-77 

<233> 

LOGICA.OBJ 

38. 

26-FEB-77 

<233> 

TOTAL  OF  380.  BLOCKS  IN  25.  FILES 
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ESM  TAPE  #4  - DIAGNOSTICS 


MCR>FLX  TT1 :=MT0 :C*. * 3*. */LI 


D I RECTOR V MTO : t O, 0 I 

10-MAR-?? 


MEMCKO. OBJ 

2. 

26-FEB-?? 

<233> 

C 1.  4 3 

6L0UT. OBJ 

2. 

26-FEB-?? 

< 2 3 3 > 

C 1-  4 I 

LPCKO. OBJ 

2 

26-FEB-?? 

<233} 

C 1,  4 3 

GTBO.  OBJ 

1. 

26-FEB-?? 

<233} 

I 1,  4 3 

CRTOBJ.  OBJ 

2 

26-FEB-77 

<233} 

1 1,  4 3 

PDPO.  OBJ 

1. 

26-FEB-?? 

<233} 

C 1,  4 I 

GTBOA. OBJ 

1. 

26-FEB-?? 

<233} 

C 1,  4 3 

CTCGO  OBJ 

2. 

26-FEB-?? 

<233} 

C 1,  4 3 

F'DP.  OBJ 

6. 

26-FEB-?? 

<233} 

Cl,  4 3 

CTCCO. OBJ 

3. 

26-FEB-?? 

<233} 

Cl-43 

CONMEM. OBJ 

5. 

26-FEB-?? 

<233} 

C 1.  4 3 

BLKS.  DAT 

9. 

26-FEB-7? 

<233} 

Cl-43 

MEMCK. PHT 

10. 

26-FEB-?? 

<233} 

Cl-43 

LPCK. DAT 

8. 

26-FEB-?? 

<233} 

Cl-43 

PDP.  DAT 

4. 

26-FEB-?? 

<233} 

Cl-43 

GTB.  DAT 

4. 

26-FEB-?? 

<233} 

Cl-43 

GTBA.  DAT 

5. 

26-FEB-?? 

<233} 

Cl-43 

CTCG. DAT 

11. 

26-FEB-?? 

<233} 

Cl-43 

CTCC.  DAT 

23. 

26-FEB-?? 

<233} 

Cl-43 

CRTCK. DAT 

21. 

26-FEB-?? 

<233} 

Cl-43 

PDP.  FOR 

3. 

26-FEB-?? 

<233} 

Cl-43 

PDP.  TSK 

31 

26-FEB-?? 

<233} 

Cl-43 

CONMEM.  FOR 

2. 

26-FEB-7? 

<23  3} 

Cl-43 

CONMEM.  TSK 

32. 

26-FEB-?? 

<233} 

Cl-43 

TI.  DAT 

5. 

10-MAR-?? 

<233} 

Cl-43 

TI.  OBJ 

1. 

10-MAR-?? 

<233} 

Cl-43 

TOTAL  OF  196.  BLOCKS  IN  26.  FILES 
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1.1  MDMPL  MICROCODE  ASSEMBLER 

The  eleven  B7*CIE  microprocessors  are  loaded  with  microcode 
object  files  that  are  stored  on  the  PDPll  processor  connected 
to  loop  #2.  The  object  files  consist  of  records  made  up  of 
128  12  bit  micro-instructions.  An  MDMPL  assembler  written  in 
FORTRAN  is  provided  with  the  ESM  for  microcode  creation  or 
modification.  The  Mini-D  Microprogramming  Language  (MDMPL)  is 
described  in  the  B7*  documentation  package.  Microcode  source 
files  can  be  created  or  edited  using  the  RX-llM  Editor  Utility 
(EDI) . The  assembler  takes  a microcode  source  file  that  consists 
of  ASCII,  80  character  fixed  fields  and  translates  it  into  a 256 
byte  binary  object  file. 

An  MDMPL  source  file  has  the  following  format: 

$12BIT  (first  line  - start  in  column  7) 

PROGRAM-ID  name,  (second  line  - start  in  column  8) 
value  statements  (start  in  column  15) 
program  statements  (start  in  column  15) 

END?,  (start  in  column  15) 


Statements  are  always  terminated  by  a period.  Labels  start  in 
column  8 and  terminate  with  a period.  Labels  can  consist  of  up 
to  7 alpha-numeric  characters  and  may  not  contain  embedded  assembler 
reserved  words,  e.g.,  EXT,  LCl,  LST , MST,  AOV,  IF,  STEP, 

SKIP,  ELSE.  Statements  may  not  start  at  or  before  column  8,  and 
by  convention  start  at  column  15.  Comments  following  statements, 
by  convention,  start  at  column  40.  A * in  column  7 indicates  a 
comment  card.  After  the  file  is  edited  using  the  EDI  Utility,  it 
must  be  put  into  a fixed  record,  80  character,  formatted  ASCII 
card  images  for  input  to  the  MDMPL  assembler.  This  can  be  done 
by  writing  the  file  to  tape,  and  then  back  again  to  disk  using 
the  file  transfer  (FLX)  utility,  e.g. 

FLX  MTO : /DO=DKO : [1,4] MICRO . DAT/RS 

FLX  DKO : /FA : 80 . =MT0 : [1, 4] MICRO. DAT 


FLX  and  EDT  commands  are  given  in  the  RSX11M  Utilities  Procedures 
Manual . 

When  the  source  file  is  properly  formatted  on  disk  (latest  version) 
run  the  MDMPL  assembler  by  entering  RUN  [20, 20] MDMPL  on  the 
DECSCOPE . The  program  will  prompt  for  the  source  filename  and 
object  filename.  By  convention,  source  microcode  files  are  of 
type  DAT,  and  object  microcode  filenames  end  with  the  character 
"O"  and  of  type  OBJ.  Default  conditions  allow  for  program 
listing  with  possible  error  messages  on  the  DECSCOPE.  Output 
may  be  stopped  by  entering  control  C,  and  it  may  be  resumed  by 
hitting  the  return  key.  For  a hard  copy  printout  enter 
RED  TT0:  = TT1:  before  running  MDMPL.  The  number  of  errors  is 
printed  at  the  end  of  the  program. 


> f 
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THE  PROGRAM 

The  assembler  is  divided  into  eleven  modules.  The  assembler's 
modules  are  structurally  overlayed  so  that  the  assembler  is  able 
to  be  executed  when  only  small  partitions  of  main  memory  are 
available.  The  overlay  structure  is  in  the  file  FASS.ODL  and 
is  set  up  as  follows: 


In  this  type  of  structure,  subroutines  on  the  same  line  are  not 
allowed  to  call  each  other,  but  are  able  to  call  any  other 
subroutine.  Following  is  a description  of  each  module  including 
the  important  variables  of  the  program. 

Main  Program  - SUSAN 

Important  Variables: 

All  variables  are  of  type  INTEGER  except  for  those  variables 
beginning  with  the  letter  "Z"  or  those  explicitly  stated  otherwise. 

ZA  - ZA  is  the  name  of  the  source  file  that  contains  the  micro- 
code to  be  translated.  This  variable  is  formatted  as  REAL* 8 and 
is  dimensioned  as  3.  This  allows  the  name  of  the  file  to  be  up  to 
24  alpha-numeric  characters  in  length  but  the  first  character  of 
the  name  must  be  a letter. 

ZX  - The  assembler  writes  the  binary  code  represented  by  the  micro- 
code of  the  source  file  to  the  object  file,  ZX.  The  variable 
is  REAL *8  and  is  dimensioned  as  3.  The  name  of  the  file  can 
be  as  long  as  24  alpha-numeric  characters  but  the  first  character 
of  the  name  must  be  a letter. 

MPAD  - MPAD  is  initialized  at  0.  MPAD  stands  for  the  Memory  Program 
Address  Descriptor.  Each  address  contains  8,  12,  or  16  bits  of 
information  , depending  on  the  value  of  DEV.  This  is  an  integer  type 
incremented  by  one  every  time  information  is  put  into  the  address. 
MPAD  is  not  incremented  for  comments,  "VALUE"  statements  or  labels 
but  is  incremented  by  two  for  "CALL"  and  "GOTO"  statements  if  DEV 
equals  12  or  16. 

Y - Y is  similiar  to  MPAD.  Y is  one  greater  than  MPAD  so  that 
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a DO  loop  can  be  used  in  the  program.  Y is  the  subscript  of  CODE 
and  is  an  INTEGER  type  variable. 

CODE  - CODE  contains  the  information  to  be  sent  to  the  object  file. 
CODE  is  256  bytes  long  and  is  written  over  to  the  object  file  when- 
ever the  256  bytes  are  filled  or  when  the  program  is  finished.  CODE 
is  dimensioned  at  128  and  is  of  type  INTEGER.  LITRL,  LOGIC,  LOGICA 
and  CONDIT  write  the  correct  information  into  CODE. 


COL  - COL  is  the  "workspace"  for  the  assembler.  Each  record 
of  the  source  file  is  read  into  COL,  one  at  a time.  The  assembler 
looks  at  this  array  checking  for  the  various  conditions  necessary. 
COL  is  of  type  INTEGER  and  is  dimensioned  at  80. 


NCOL  - NCOL  is  created  by  SQUASH  by  taking  all  spaces  or  blanks 
out  of  COL.  This  allows  the  assembler  to  look  at  a microcode 
instruction  and  expect  a semi-ordered  field.  The  array  NCOL  is 
dimensioned  at  30  and  of  type  INTEGER. 


N - N keeps  track  of  the  number  of  errors.  If  N is  equal  to 
10,  the  assembler  will  stop.  N is  an  integer  variable. 


Alpha-numeric  Characters  - A - Z and  0-9  are  represented  as 
variables  with  Q's  between  the  characters  themselves.  For  example, 
"K"  = QKQ  and  "5"  = Q5Q. 


_ It  J M 


QAR  = 

QBR  = 

QCR  = 

QDR  = "=" 


Other  special  variables  are  as  listed: 
QER  = 

QFR  = "$" 

QGR  = "G" 

QHR  = " " 


All  alpha-numeric  variables  are  of  type  LOGICAL* 1. 

Eg.  Searching  for  an  equal  sign  in  column  4 is  done  by  the  code 
" IF  (NCOL (4) .EQ.QDR) . . .") 

FVAR,  WAR,  VCON , VAR,  CON  - FVAR  contains  the  variable  name 
from  a "B  ="  literal  assignment  statement.  This  corresponds  to  the 
"VALUE"  statement  of  label  with  the  same  variable.  Each  subscript 
of  the  array  WAR  contains  the  variable  before  "VALUE"  and  VCON 
contains  the  constant  corresponding  to  it.  VAR  contains  the  labels 
that  start  in  column  8 and  CON's  array  contains  the  address  of  where 
each  label  is  located.  FVAR,  WAR  and  VAR  are  LOGICAL*l  variables. 

VCON  and  CON  are  INTEGERS. 

(Eg.  B = ZERO.  ZERO  is  put  into  FVAR.  The  assembler  then  looks 
at  WAR  and  VCON  which  respectively  contain  ZERO  and  0 which  was 
accomplished  from  the  microcode  instruction:  ZERO  VALUE  0.) 

Description : 

The  main  program  (SUSAN)  calls  RESCAN,  SQUASH,  WRT,  CONDIT,  COLUMN, 
LITRL,  LOGIC,  SCAN.  The  only  input  is  the  source  file  ZA.  The 
output  files  are  the  object  file  ZX,  and  the  DECWRITER  or  the  DECSCOPE. 
The  main  program  looks  at  the  file  ZA  eighty  character  records  at  a 
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time.  It  handles  the  "number  of  bits"  record,  the  "Program  - ID" 
record  and  the  "END?."  record.  It  also  takes  care  of  the  preliminary 
testing  necessary  to  send  the  microcode  instruction  line  to  the  proper 
module  for  further  testing  and  manipulation.  The  preliminary  testing 
includes  checking  for  a period,  an  equal  sign,  a character  in  column 
8,  an  asterik,  or  any  reserved  words.  Reserved  words  include  "IF", 

" B=" , "STEP",  "EXEC".  If  an  error  occurs,  the  subroutine  WRT  is 
called  to  report  the  error  to  the  user. 

BLOCK  DATA 

Description: 

The  BLOCK  DATA  contains  all  the  necessary  COMMON  areas  and  COMMON 
data  necessary  for  the  assembler.  All  variables  are  explicitly 
defined  here. 

COLUMN 

Important  Variables: 

X - X contains  a 1 if  "VALUE"  is  in  NCOL.  If  "VALUE"  is  not  in  NCOL, 

X is  equal  to  0 and  informs  the  assembler  that  the  instruction  is  a 
label.  X is  an  integer. 

DCOL  - If  a subscript  of  NCOL  contains  a numeric  character,  the 
same  subscript  of  DCOL  becomes  its  numeric  decimal  value.  This 
array  is  dimensioned  at  30  and  is  of  INTEGER  type. 

NCOL  - NCOL  is  created  by  SQUASH  by  taking  all  spaces  or  blanks  out 
of  COL.  This  allows  the  assembler  to  look  at  a microcode  instruction 
and  expect  a semi-ordered  field.  The  array  NCOL  is  dimensioned  at 
30  and  is  of  type  INTEGER. 

WAR  - WAR  is  a list  of  the  variables  that  come  before  the  reserved 
word  "VALUE"  in  a "VALUE"  statement.  Variables  and  labels  are 
allowed  to  be  up  to  7 characters  long.  WAR  is  dimensioned  as  (80,  8) 
and  is  of  type  LOGICAL* 1. 

C - The  array  C aids  in  the  process  of  getting  the  variable  before 
"VALUE"  of  a "VALUE"  statement  into  WAR.  It  is  an  INTEGER  type  and 
is  dimensioned  at  15. 

VCON  - VCON  contains  a list  of  all  the  constants  from  the  "VALUE" 
statements.  WAR  contains  the  variables  corresponding  to  the 
constants  in  VCON.  VCON  receives  its  values  from  the  variable  AC. 

VCON  is  dimensioned  at  80. 

V - WAR  and  VCON  are  lists  of  labels  and  constants  corresponding  to 
each  "VALUE"  statement  found.  V acts  as  a t.  ainter  for  these  queues. 

If  the  assembler  is  looking  for  the  fifth  "VALUE"  statement,  V will 
have  a value  of  5.  V is  an  INTEGER. 

AC  - AC  contains  the  constant  following  "VALUE"  in  decimal  form.  It 
uses  the  number  represented  by  the  decimal  values  in  DCOL  to  form 
a constant.  AC's  maximum  value  is  255. 
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VAR  - VAR  is  a list  for  all  labels.  VAR  is  dimensioned  at  (100,  8). 
The  labels  contained  in  VAR  can  be  only  7 characters  long. 


L - L is  similiar  to  V.  It  is  a pointer  for  VAR  and  CON.  L's 
maximum  value  is  100. 

CON  - CON  contains  the  MPAD  value  of  the  corresponding  label  found 
in  VAR.  CON's  dimension  is  100  and  it  is  an  INTEGER  variable. 


Description: 

COLUMN  is  called  by  SUSAN.  COLUMN  calls  SCAN  and  WRT . The  variables 
V and  L are  sent  as  parameters  between  COLUMN  and  SUSAN. 

COLUMN  is  called  by  SUSAN  if  the  reserved  word  "VALUE"  is  in  the 
instruction  or  if  there  is  a character  in  column  8.  If  the  word 
"VALUE"  is  found,  WAR  and  VCON  receive  the  correct  values.  If 
column  8 is  occupied,  VAR  and  CON  receive  their  appropriate  values. 
These  arrays  are  used  to  calculate  the  code  of  an  instruction  when 
it  reaches  LITRL. 

WRT 

Important  Variables: 

VARF  - VARF  is  the  variable  corresponding  to  the  error  messages. 

For  every  value  of  VARF  there  is  an  error  message  printed  related 
to  the  syntax  condition  that  was  broken.  VARF  is  an  INTEGER.  It 
is  sent  by  the  program  calling  WRT. 

PCK  - PCK  is  set  at  1,  2,  3,  4 or  5,  and  is  set  by  the  program  call- 
ing WRT.  A "1"  writes  the  line  only  (COL);  a "2"  writes  the  line 
(COL)  with  CODE(Y)  = 77777,  MPAD,  the  error  message  and  increments  N; 
a "3"  writes  the  number  of  errors;  a "4"  writes  the  MPAD,  CODE(Y)  and 
the  line  (COL);  and  a "5"  writes  only  the  error  message. 

N - N keeps  track  of  the  number  of  errors.  If  N is  equal  to  10,  the 
the  assembler  will  stop.  N is  an  INTEGER  variable. 

MPAD,  CODE  (Y) , COL  - The  contents  of  all  these  are  printed 
whenever  a line  is  sent  to  the  DECWRITER  or  DECSCOPE.  This  is  exe- 
cuted if  PCK  equals  "4". 

MPAD  - MPAD  is  initialized  at  0.  MPAD  stands  for  the  Memory  Program 
Address  Descriptor.  Each  address  contains  8,  12  or  16  bits  of  in- 
itiation, depending  on  the  value  of  DEV.  This  is  an  integer  type 
variable  incremented  by  one  everytime  information  is  put  into  the 
address.  MPAD  is  not  incremented  for  comments,  "VALUE"  statements 
or  labels  but  is  incremented  by  2 for  "CALL"  or  "GOTO"  statements 
if  DEV  equals  12  or  16. 

CODE  - CODE  contains  the  information  to  be  sent  to  the  object  file. 
CODE  is  256  bytes  long  and  is  written  over  to  the  object  file 
whenever  the  256  bytes  are  filled  or  when  the  program  is  finished. 
CODE  is  dimensioned  at  128  and  is  of  type  INTEGER.  LITRL,  LOGIC, 
LOGICA,  and  CONDIT  write  the  correct  information  into  CODE. 
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COL  - COL  contains  the  "workspace"  for  the  assembler.  Each  record 
of  the  source  file  is  read  into  COL,  one  at  a time.  The  assembler 
looks  at  this  array  checking  for  the  various  conditions  necessary. 
COL  is  of  type  INTEGER  and  is  dimensioned  at  80. 

Description : 

WRT  is  called  by  SUSAN,  COLUMN,  CONDIT,  LOGICA,  LOGIC,  LITRL  and 
SQUASH.  WRT  writes  its  output  to  either  the  DECWRITER  or  the 
DECSCOPE.  WRT  is  divided  into  5 sections  and  depending  on  the 
value  of  PCK  that  section  is  executed.  Depending  on  the  value  of 
PCK , WRT  will  either  write  only  the  line;  or  write  the  line,  the 
MPAD  value,  CODE(Y)  value  of  77777,  the  error  message  and  increment 
N;  or  write  the  number  of  errors;  or  write  the  line,  the  MPAD 
value  and  the  CODE(Y)  value;  or  write  only  the  error  message.  Most 
of  the  output  writing  of  this  assembler  is  accomplished  by  this 
subprogram. 

CONDIT 


Important  Variables: 

NCOL  - NCOL  is  created  by  SQUASH  by  taking  all  spaces  or  blanks 
out  of  COL.  This  allows  the  assembler  to  look  at  a microcode 
instruction  and  expect  a semi-ordered  field.  The  array  NCOL  is 
dimensioned  at  30  and  of  type  INTEGER. 

CODE  - CODE  contains  the  information  to  be  sent  to  the  object  file. 
CODE  is  256  bytes  long  and  is  written  over  to  the  object  file  when- 
ever the  256  bytes  are  filled  or  when  the  program  is  finished.  CODE 
is  dimensioned  at  128  and  is  of  type  INTEGER.  LITRL,  LOGIC,  LOGICA 
and  CONDIT  write  the  correct  information  into  CODE. 


Y - Y is  similiar  to  MPAD.  Y is  one  greater  than  MPAD  so  the  a DO 
loop  can  be  used  in  the  program.  Y is  the  subscript  of  CODE  and 
is  an  INTEGER  type  variable. 

MPAD  - MPAD  is  initialized  at  0.  MPAD  stands  for  the  Memory  Program 
Address  Descriptor.  Each  address  contains  8,  12  or  16  bits  of  infor- 
mation, depending  on  the  value  of  DEV.  This  is  an  integer  type 
variable  incremented  by  one  everytime  information  is  put  into  the 
address.  MPAD  is  not  incremented  for  comments,  "VALUE"  statements  or 
labels,  but  is  incremented  by  2 for  "CALL"  or  "GOTO"  statements  if 
DEV  equals  12  or  16. 


Alpha-numeric  characters  - A - Z and  0-9  are  represented  as 
variables  with  Q's  between  the  characters  themselves.  For  example, 
"K"  = QKQ  and  "5"  = Q5Q.  Other  special  variables  are  as  listed: 

QAR  = "+" 

QBR  = 

QCR  = 

QDR  = "=" 


QER  = 

QFR  = 

QGR  = "G" 
QHR  = " " 
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All  alpha-numeric  variables  are  of  type  L0GICAL*1. 

(Eg.  Searching  for  an  equal  sign  in  column  4 is  done  by  the  code 
"IF  (NC0L(4) .EQ.QDR) . . .") 

Description : 

CONDIT  calls  SCAN  and  WRT.  CONDIT  is  called  by  the  main  program  SUSAN 
if  any  of  the  reserved  words,  "IF",  "STEP",  "SKIP",  "JUMP",  "EXEC" 
are  found.  All  condition  statements  are  sent  here.  There  can  not  be 
any  or  "+"  signs  and  there  must  be  a period. 

CONDIT  checks  for  "STEP",  "JUMP",  "EXEC",  "SKIP",  "MST",  "AOV" , 

"LST" , "ABT" , "EXT",  "LCl",  "LC2"  and  "LC3" . Depending  on  what  is 
found,  CODE(Y)  representing  that  instruction  is  set  to  the  correct 
value . 


SQUASH 

Important  Variables: 

NCOL  - NCOL  is  created  by  SQUASH  by  taking  all  spaces  or  blanks 
out  of  COL.  This  allows  the  assembler  to  look  at  a microcode 
instruction  and  expect  a semi-ordered  field.  The  array  NCOL  is 
dimensioned  at  30  and  of  type  INTEGER. 

COL  - COL  is  the  "workspace"  for  the  assembler.  Each  record  of  the 
source  file  is  read  into  COL,  one  at  a time.  The  assembler  looks  at 
this  array  checking  for  the  various  conditions  necessary.  COL  is 
of  type  INTEGER  and  is  dimensioned  at  80. 

QER  - Represents  a "." 

QHR  - Represents  a " " . 

Description: 

This  subroutine  calls  WRT  for  its  relay  of  error  messages  to  the  user. 
SQUASH  is  called  by  SUSAN  and  RESCAN.  This  subroutine  creates  NCOL. 

By  igoring  all  blanks,  most  microcode  instructions  are  no  more  than 
25  characters  in  length.  This  also  enables  fixed  fields  to  be  set  up 
to  allow  for  the  scanning  of  reserved  words  in  certain  columns. 

(Eg.  such  as  "IF"  in  columns  1 and  2.) 

SCAN 

Important  Variables: 

A - A is  either  a 1,  2,  3 , 4 or  5 depending  on  the  length  of  the 
Reserved  Word  being  scanned  for.  If  A is  greater  than  5,  then  SCAN 
simply  returns  to  the  subprogram  that  called  it. 

B,  C,  D,  E,  F - Contain  the  characters  of  the  reserved  word  that  is 
being  scanned  for,  one  character  per  variable.  If  C,  D,  E or  F 
are  not  being  used  they  are  sent  to  SCAN  anyway  set  at  0.  They 
are  type  INTEGER. 

J - If  the  reserved  word  was  found,  J is  sent  back  to  the  program 
that  called  SCAN  with  the  value  of  the  column  where  the  last  char- 
acter being  scanned  for  was  found  in  NCOL.  If  the  reserved  word 
was  not  found,  J is  sent  back  equal  to  0. 
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Alpha-numeric  Characters  - A - Z and  0-9  are  represented  as 
variables  with  Q's  between  the  characters  themselves.  For  example, 
"K"  = QKQ  and  "5"  = Q5Q.  Other  special  variables  are  as  listed: 


QAR  = "+" 

QER  = 

QBR  = 

QFR  = 

OCR  = 

QGR  = 

QDR  = "=" 

QHR  = 

All  alpha-numeric  variables  are  of  type  LOGICAL* 1. 

(Eg.  Searching  for  an  equal  sign  in  column  4 is  done  by  the  code 
"IF  (NCOL  (4)  . EQ.QDR)  . . . ") 

G - G is  SCAN's  COMMON  name  for  NCOL,  the  "squashed"  COL.  G does 
not  have  any  spaces  until  after  the  period. 

SCAN  - SCAN  is  a variable  since  the  subprogram  is  an  integer  function. 
If  the  word  being  scanned  for  is  found,  SCAN  comes  back  with  a 1; 
if  not,  it  comes  back  with  a 0. 

Description: 

SCAN  does  not  call  any  subroutines.  It  is  called  by  SUSAN,  LITRL, 
LOGIC,  LOGICA,  RESCAN,  COLUMN  and  CONDIT.  SCAN  is  an  integer 
function  that  determines  whether  or  not  a reserved  word  is  in 
NCOL  (or  G) . If  it  is,  SCAN  receives  a 1 and  if  not,  it  receives  a 
0.  The  subprogram  also  states  where  the  last  character  of  the  re- 
served word  was  found  in  NCOL.  This  subprogram  is  used  extensively 
throughout  the  assembler  program. 

LITRL 

Important  Variables: 

V - WAR  and  VCON  are  lists  of  labels  and  constants  corrsponding  to 
each  "VALUE"  statement  found.  V acts  as  a pointer  for  these  queues. 

If  the  assembler  is  looking  for  the  fifth  value  statement,  V will 
have  a value  of  5.  V is  an  INTEGER. 

NCOL  - NCOL  is  created  by  SQUASH  by  taking  all  spaces  of  blanks 
out  of  COL.  This  allows  the  assembler  to  look  at  a microcode 
instruction  and  expect  a semi-ordered  field.  The  array  NCOL  is 
dimensioned  at  30  and  of  type  INTEGER. 

DCOL  - If  a subscript  of  NCOL  contains  a numeric  character,  the  same 
subscript  of  DCOL  becomes  its  numeric  decimal  value.  This  array  is 
dimensioned  at  30  and  is  an  INTEGER. 

AC  - AC  contains  the  constant  following  "VALUE"  in  decimal  form.  It 
takes  the  number  represented  by  the  decimal  values  in  DCOL.  AC's 
maximum  value  is  225. 

VCON  - VCON  contains  a list  of  all  the  constants  from  the  "VALUE" 
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statements.  WAR  contains  the  variables  corresponding  to  the 
constants  in  VCON.  VCON  receives  its  constants  from  the  variable  AC. 
VC ON  is  dimensioned  at  80. 

C - C is  equal  to  1 if  the  line  contains  the  reserved  word  "CALL" 
and  0 if  it  does  not. 


FVAR  - FVAR  contains  the  variable  name  from  a "B  ="  statement. 

This  corresponds  to  the  "VALUE"  statements  or  labels  with  the  same 
variable.  FVAR  is  an  array  dimensioned  at  8 and  is  a LOGICAL* 1 
type  array. 

MPAD  - MPAD  is  initialized  at  0.  MPAD  stands  for  the  Memory  Program 
Address  Descriptor.  Each  address  contains  8,  12  or  16  bits  of 
information,  depending  on  the  value  of  DEV.  This  is  an  INTEGER  type 
incremented  by  one  everytime  information  is  put  into  the  address. 

MPAD  is  not  incremented  for  comments,  "VALUE"  statements  or  labels  but 
is  incremented  by  2 for  "CALL"  and  "GOTO"  statements  if  DEV 
equals  12  or  16. 

Y - Y is  similiar  to  MPAD.  Y is  one  greater  than  MPAD  so  that 
a DO  loop  can  be  used  in  the  program.  Y is  the  subscript  of  CODE 
and  is  an  INTEGER  type  variable. 

CODE  - CODE  contains  the  information  to  be  sent  to  the  object  file. 
CODE  is  256  bytes  long  and  is  written  over  to  the  object  file  whenever 
the  256  bytes  are  filled  or  when  the  program  is  finished.  CODE  is 
dimensioned  at  128  and  is  of  type  INTEGER.  LITRL,  LOGIC,  and  CONDIT 
write  the  correct  information  into  CODE. 

CON  - CON  contains  the  MPAD  value  of  the  label  in  VAR. 


VAR  - The  variable  FVAR  is  compared  to  the  list  VAR.  If  the  value 
in  FVAR  is  found  in  VAR,  the  corresponding  MPAD  value  is  found  in 
CON  and  is  added  to  the  present  value  of  CODE (Y) . It  is  a LOGICAL* 1 
type  array. 


Alpha-numeric  Characters  - A - Z and  0-9  are  represented  as 
variables  with  Q's  between  the  characters  themselves.  For  example, 
"K"  = QKQ  and  "5"  = Q5Q.  Other  special  variables  are  as  listed: 


QAR  = "+" 
QBR  = "-" 
QCR  = "*" 
QDR  = "=" 


QER  = 
QFR  = 
QGR  = 
QHR  = 


II  f II 


All  alpha-numeric  variables  are  of  type  LOGICAL* 1. 

Eg.  Searching  for  an  equal  sign  in  column  4 is  done  by  the  code 
"IF  (NCOL (4) .EQ.QDR) . . . ") 


Description: 

LITRL  is  called  by  SUSAN  if  the  reserved  words  "DEV", 
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"CALL"  or  "GOTO"  are  found  in  NCOL.  LITRL  calls  SCAN  and  WRT.  The 
first  part  of  the  program  handles  all  "DEV"  statements.  It  calculates 
the  constant  to  the  right  of  the  equal  sign  and  sends  the  correct 
code  to  CODE  (Y) . The  program  also  checks  a microcode  instruction  to 
see  if  it  is  either  a "CALL"  or  a"  GOTO"  statement.  In  RESCAN,  VAR  is 
complete  so  LITRL  knows  what  address  the  "CALL"  or  "GOTO"  statement  is 
referring  to  even  if  it  is  a forward  reference.  "CALL"  and  "GOTO" 
statements  receive  2 address  locations  and  they  receive  the  correct 
CODE  from  CON. 

RESCAN 

Important  Variables: 

CCT  - CCT  is  the  number  of  records  read  of  the  source  file  ZA.  It 
is  an  INTEGER  variable. 


DEV  - DEV  takes  on  the  value  8,  12  or  16.  The  way  the  assembler  is 
now  written,  it_ really  is  not  that  important.  However,  the  assembler 
can  be  programmed  to  act  differently  depending  on  the  value  of  DEV. 

It  can  be  programmed  to  work  on  an  8,  12  or  16  bit  machine. 

Alpha-Numeric  Characters  - A - Z and  0-9  are  representes  as 
variables  with  Q's  between  the  characters  themselves.  For  example. 


= QKQ  and  "5"  = Q5Q. 

Other  special  variables  are  as  listed: 

QAR  = "+" 

QER  = " . " 

QBR  = 

QFR  = "$" 

QCR  = "*" 

QGR  = "G" 

QDR  = "=" 

QHR  = " " 

All  alpha-numeric  variables  are  of  type  LOGICAL* 1. 

(Eg.  Searching  for  an  equal  sign  in  column  four  is  done  by  the  code 
"IF  (NCOL (4) .EQ.QDR) ...") 

DUP  - DUP  is  initialized  at  0.  If  there  is  a duplicate  label,  DUP 
is  set  to  1 and  an  error  message  is  written.  DUP  is  an  INTEGER. 

VAR  - VAR  is  a list  for  all  labels.  VAR  is  dimensioned  at  (100,  8) . 
The  labels  contained  in  VAR  can  be  only  7 characters  long.  VAR  is  a 
LOGICAL* 1 array. 

CON  - CON  contains  the  MPAD  value  of  the  corresponding  label  found 
in  VAR.  CON's  dimension  is  100  and  is  an  INTEGER  variable. 

FVAR  - FVAR  contains  the  variable  name  from  a "B  ="  statement.  This 
corresponds  to  the  "VALUE"  statement  or  label  with  the  same  variable. 
FVAR  is  an  array  dimensioned  at  8 and  is  a LOGICAL* 1 type  array. 

COL  - COL  is  the  "workspace"  for  the  assembler.  Each  record 
of  the  source  file  is  read  into  COL,  one  at  a time.  The  assembler 
looks  at  this  array  checking  for  the  various  conditions  necessary. 

COL  is  of  type  INTEGER  and  is  dimensioned  at  80. 
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MP  - MP  is  RESCAN's  MPAD. 


Description : 

RESCAN  is  called  by  SUSAN.  RESCAN  calls  SQUASH. 

This  assembler  is  a two-pass  assembler  with  the  first  pass  being 
accomplished  by  RESCAN.  RESCAN  is  call  by  SUSAN  in  order  to  pre-scan 
for  all  labels  and  label  addresses  so  that  VAR  and  CON  are  complete 
with  the  necessary  information  before  the  second  pass  is  made. 

If  there  is  a new  label,  that  label  is  put  into  VAR.  All  "VALUE" 
statements  must  be  before  any  other  executable  statement.  RESCAN 
lets  the  user  know  when  the  first  pass  is  being  performed  oy  relaying 
the  message  "WAIT  FOR  FIRST  PASS-SCAN  FOR  LABELS"  to  him. 


LOGIC 


Important  Variables: 

NCOL  - NCOL  is  created  by  SQUASH  by  taking  all  spaces  of  blanks 
out  of  COL.  This  allows  the  assembler  to  look  at  a microcode 
instruction  and  expect  a semi-ordered  field.  The  array  NCOL  is 
dimensioned  at  30  and  of  type  INTEGER. 


CODE  - CODE  contains  the  information  to  be  sent  to  the  object  file. 
CODE  is  256  bytes  long  and  is  written  over  to  the  object  file  when- 
ever the  256  bytes  are  filled  or  when  the  program  is  finished.  CODE 
is  dimensioned  at  128  and  is  of  type  INTEGER.  LITRL,  LOGICA  and 
CONDIT  write  the  correct  information  into  CODE. 


Y - Y is  similiar  to  MPAD.  Y is  one  greater  than  MPAD  so  that 
a DO  loop  can  be  used  in  the  program.  Y is  the  subscript  of  CODE 
and  is  an  INTEGER  type  variable. 


MPAD  - MPAD  is  initialized  at  0.  MPAD  stands  for  the  Memory  Program 
Address  Descriptor.  Each  address  contains  8,  12  or  16  bits  of 
information,  depending  on  the  value  of  DEV.  This  is  an  INTEGER  type 
incremented  by  one  everytime  information  is  put  into  the  address. 
MPAD  is  not  incremented  for  comments,  "VALUE"  statements  or  labels 
but  is  incremented  by  2 for  "CALL"  and  "GOTO"  statements  if  DEV 
equals  12  or  16. 


Alpha-Numeric  Characters  - A - Z and  0-9  are  represented  as 
variables  with  Q's  between  the  characters  themselves.  For  example, 
"K"  = QKQ  and  "5"  = Q5Q.  Other  special  variables  are  as  listed: 


QAR  = "+" 

QER  = 

QBR  = 

QFR  = 

QCR  = 

QGR  = 

QDR  = "=" 

QHR  = 

_ II  || 


_ II  £ II 


All  alpha-numeric  variables  are  of  type  LOGICAL*l. 

(Eg.  Searching  for  an  equal  sign  in  column  4 is  done  by  the  code 
"IF  NCOL (4) .EQ.QDR) ...") 
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U - U is  LOGIC'S  DCOL . It  translates  numeric  characters  into  numeric 
decimal  values.  It  is  dimensioned  at  30. 

COL  - COL  is  the  "workspace"  for  the  assembler.  Each  record  of 
the  source  file  is  read  into  COL,  one  at  a time.  The  assembler 
looks  at  this  array  checking  for  the  various  conditions  necessary. 

COL  is  of  the  type  INTEGER  and  is  dimensioned  at  80. 

T - T represents  the  position  of  the  column  that  follows  the  column 
that  contains  an  "="  sign.  This  is  used  extensively  to  figure  out 
what  follows  the  "="  sign  in  a statement. 

Description : 

LOGIC  calls  SCAN,  WRT  and  LOGICA.  It  is  called  by  SUSAN  (main  pro- 
gram) when  the  reserved  words  "Al",  "A2",  "A3",  "B=",  "BEX",  "=" 
or  "ONES"  are  found.  LOGIC,  with  the  help  of  LOGICA,  handles  all 
the  syntax  required  for  the  reserved  words.  The  program  checks  for 
required  syntax  before  the  equal  sign,  finds  the  equal  sign  and  then 
checks  for  the  required  syntax  that  follows  it.  If  there  are  any 
syntax  errors,  the  error  message  "FORMAT  ERROR  - UNDEFINED  SEMANTICS" 
or  a more  explanatory  message  will  be  relayed  to  the  user. 

LOGICA 

Important  Variables: 

NCOL  - NCOL  is  created  by  SQUASH  by  taking  all  spaces  of  blanks 
out  of  COL.  This  allows  the  assembler  to  look  at  a microcode 
instruction  and  expect  a semi-ordered  field.  The  array  NCOL  is 
dimensioned  at  30  and  of  type  INTEGER. 

CODE  - CODE  contains  the  information  to  be  sent  to  the  object  file. 
CODE  is  256  bytes  long  and  is  written  over  to  the  object  file  when- 
ever the  256  bytes  are  filled  of  when  the  program  is  finished.  CODE 
is  dimensioned  at  128  and  is  of  type  INTEGER.  LITRL,  LOGICA  and 
CONDIT  write  the  correct  information  into  CODE. 

T - T represents  the  position  of  the  column  that  follows  the  column 
that  contains  an  "="  sign.  This  is  used  extensively  to  figure  out 
what  follows  the  "="  sign  in  a statement. 

Y - Y is  similiar  to  MPAD . Y is  one  greater  than  MPAD  so  that  a 
DO  loop  can  be  used  in  the  program.  Y is  the  subscript  of  CODE  and 
is  an  INTEGER  type  variable. 

MPAD  - MPAD  is  initialized  at  0.  MPAD  stands  for  the  Memory  Program 
Address  Descriptor.  Each  address  contains  8,  12  or  16  bits  of 
information,  depending  on  the  value  of  DEV.  This  is  an  INTEGER 
type  incremented  by  one  everytime  information  is  put  into  the  address. 
MPAD  is  not  incremented  for  comments,  "VALUE"  statements  or  labels 
but  is  incremented  by  two  for  "CALL"  and  "GOTO"  statements  if  DEV 
equals  12  or  16. 

Alpha-Numeric  Characters  - A - Z and  0-9  are  represented  as 
variables  with  Q's  between  the  characters  themselves.  For  example. 
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"K"  = QKQ  and  "5"  = Q5Q.  Other  special  variables  are  as  listed: 


f 


QAR  = "+" 

QER  = 

QBR  = 

QFR  = 

QCR  = 

QGR  = 

QDR  = "=" 

QHR  = 

All  alpha-numeric  variables  are  of  type  L0GICAL*1. 

(Eg.  Searching  for  an  equal  sign  in  column  4 is  done  by  the  code 
"IF  (NC0L(4) .EQ.QDR) ...") 

COL  - COL  is  the  "workspace"  fcr  the  assembler.  Each  record 
of  the  source  file  is  read  into  COL,  one  at  a time.  The  assembler 
looks  at  this  array  checking  for  the  various  conditions  necessary. 

COL  is  of  type  INTEGER  and  is  dimensioned  at  80. 

Description: 

LOGICA  calls  SCAN  and  WRT . LOGICA  is  called  by  LOGIC  when  the 
character  after  the  equal  sign  is  an  A.  It  checks  for  reserved 
words  and  characters  such  as  " + ",  "NOR",  and  "EQV"  that  follow 

the  "Al",  " A2 " , "A3"  of  "AMPCR"  that  directly  follows  the  equal 
sign  in  the  microcode  program.  LOGICA  works  very  similarly  to 
LOGIC,  with  the  correct  information  going  into  CODE(Y)  when  a certain 
syntax  is  met. 

Task  Building: 

The  RSXllM  task  builder  utility  (TKB)  is  used  to  build  the  MDMPL 
task  from  the  object  files  and  overlay  description  language  file. 

The  following  TAB  commands  are  used: 

TKB  [20,20] MDMPL ,TSK=FASS .ODL/MP , [ 1 , 1 ] SYSLIB/LB : $SHORT 
Options : 

UNITS  = 3 
ACTFIL  = 3 

ASG  = TT1 : 1 , SY0:2:3 
MAXBUF  = 256 
EXTSCT  = $$FSR1 : 2264 


Notes  Concerning  the  MDMPL  Assembler  Flowchart: 


Table  A gives  the  flowchart  letter  connectors  and  their  corresponding 
positions  in  the  program.  In  the  program,  whenever  a search  for  a 
reserved  word  occured,  the  subfunction  SCAN  was  called.  SCAN  sends 
back  the  position  of  the  last  letter  of  the  reserved  word  found  in 
NCOL  and  whether  or  not  the  reserved  word  was  actually  located.  In 
the  flowchart,  LOGICA  is  included  with  LOGIC.  The  beginning  of 
LOGICA  is  located  at  Z in  the  flowchart. 


J 
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TABLE  A 

FLOWCHART  LETTER  CONNECTOR  PROGRAM  LOCATION  (MODULE  - LABEL) 


A 

SUSAN 

- 30 

B 

SUSAN 

- 240 

C 

RESCAN 

- 47 

D 

RESCAN 

- 44 

E 

RESCAN 

- 48 

F 

SCAN  - 

1 

G 

SCAN  - 

2 

H 

SCAN  - 

3 

I 

SCAN  - 

4 

J 

SCAN  - 

5 

K 

LITRL 

- 1 

L 

LITRL 

- 11 

M 

LITRL 

- 9 

N 

LITRL 

- 15 

0 

COLUMN 

- 15 

P 

CONDIT 

- 15 

Q 

LOGIC 

- 100 

R 

LOGIC 

- 500 

S 

LOGIC 

- 696 

T 

LOGIC 

- 305 

U 

LOGIC 

- 509 

V 

LOGIC 

- 650 

W 

LOGIC 

- 600 

X 

LOGIC 

- 550 

Y 

LOGIC 

- 670 

Z 

LOGIC 

- 1000 

AA 

LOGIC 

- 695 

BB 

LOGIC 

- 690 

CC 

LOGIC 

- 2000 

DD 

LOGIC 

- the  third 
statement 

executable 
after  2010 

.ROOT  SUSAN-*BLOCK-*RESCAN-*I 
It  .FCTR  URT-* (SQUASH, *J> 

JJ  .FCTR  SCAN-# ( COLUMN » CONDIT . LI TRL » *K > 

Kt  .FCTR  L0GIC-*L06ICA 

.END 

*ED 

CEXIT3 

> 
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FLOWCHART  OF  THE  MDMPL 
ASSEMBLER 


SUSAN-MAIN  PROGRAM 


( START 


Figure  1-1.  SUSAN  - Main  Program 
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SUSAN- MAIN  PROGRAM  (cont.) 


"YAH  i:”\Yes 
in  >— ■ 

NCOL  / 


/ "IF"  \ 
"STEP",  "JIMP" 
"EXEC"  or  "SKIP" 


WRITE  MPAD, 
CODEI4),  COL  and 
"Format  Error- 
Value  Statement 
only  in  column  8.  " 


/"DEV"^\ 
"CALL" 
or  "GOTO" 


</NCOL(1)="B"n 

and 

VNCCL'2)  = "=> 


' WRITE  MPAD  / 
CODE  (Y),  COL  and/ 
"Format  Error-  / 
No  Equal  Sign"  / 


Y 

MPAD 

r + l 
•+I 

= MPAD+1 

Y = 4 + 1 
N = N + 1 
M P A D = M P A D+ 1 


CONDIT 

\ 

/^NCOU3)\ 
/^O",  "1",  =2", 
"3",  "4",  "5",  "6", 
"8".  or  "9" 


✓/NCOL(3)  = "B" 
/ and 

NCOL(4)  = ".  ",  "+" 
or  "F" 


/NCOL(3)  = "A" 
and 

NCOL(4)="l", 
"2",  or"3" 


NCOL(3)  = "0" 
NCOL(4)  = "N' 
NCOL(5)  = "E' 
NCOL(6)  = "S" 


Figure  1-1.  (Cont.) 
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j FORTRAN  IV  V01B-02  SAT  26-FEB-77  17)29: 16  PAGE  001 

CORE=08K>  UIC=C20f203  SUSAN • 0BJ=SUSAN . F0R/N0SN/LI ! 1 

C SUSAN  IS  THE  NAME  OF  AN  ASSEMBLER  MAIN  PROGRAM  DESIGNED  TO 

C TRANSLATE  MDMPL  INTO  B7*  MACHINE  CODE.  THE  PROGRAM  WILL  BE  USED 

C ON  THE  PDP-11  WHICH  ONLY  HAS  A FORTRAN  COMPILER. 

C 

C BECAUSE  THE  PROGRAM  ONLY  USES  INTEGERS f ALL  VARIABLES  EXCEPT 

C THOSE  BEGINNING  WITH  A 'Z'  ARE  INTEGERS.  THE  PROGRAM  HAS 

C EIGHT  SUBPROGRAMS. 

0001  IMPLICIT  INTEGER  (A-Y) 

0002  L0GICALH1  WAR  r F VAR f VAR 

0003  L0GICAL41  NCOL  fQAQfQBQfQCQf  QDO f QEO f QFQ  f OGCJ r OHO f QIQ  f QJQ  t QKQ r QLQ » 

1 QMQ F QNQ . OOQ . QPQ f OOQ  f QRQ  f QSQ  f QTQ  f QUO  f QVO  f QUO  f QXQ  f Q YQ  f OZQ  f OOQ  f 
2Q1QfQ2QfQ3QfQ4Qf05Qf06QfQ7QfQ8QfQ9C1f0ARfQBRfQCRfQDRfQERfQFRf 
3QGR  f QHR f COL 

0004  COMMON  NCOL (30) 

0003  COMMON  /VAL/VVAR ! 80  f 8 > f VCON ! 80 ) 

0006  COMMON  /PAR/  PP1fPP2 

0007  COMMON  /SJI/FVAR ( 8 ) f VAR( 100 .8) f CON< 100 > 

0008  COMMON  /IMP/COL ! 80 ). CODE < 128 ) 

0009  COMMON  /VAX/N . MPAD , FR f Y 

0010  REAL46  ZA.ZX 

0011  COMMON  /FILE/ZA(3) fZXC3) fRECNO 

0012  COMMON  /CODES/OAOFOBQFQCQFQDO.QECJFQrQFQGQFQHQFQIQFOJQFQKOFQLaF 

1 QMQ f QNQ  f QOG  fQPQfQQQfQRQfQSQfQTQfQUQfQVQfQUOfQXQfOYQfQZQfGOGfQIOf 
202Q  F Q3Q F Q4Q  F 05Q  f Q6G  f Q7Q  f Q8Q  fQ9Qf QAR  f QBR  f QCR  f QDR  f QER  f QFR f QGR  f QHR 

0013  COMMON  /DSK/  V8fV9 

0014  COMMON  /SULIT/ID7 

C THE  NUMBER  OF  BITS  CONTROL  CARD  IS  READ  IN  FIRST  TO  DESIGNATE 

C THE  NECESSITY  FOR  A LIT-TO-IR  CODE  PRECEDING  ALL  CALL  OR  GOTO 

C STATEMENTS.  THIS  OCCURS  FOR  A 12  OR  16  BIT  MACHINE. 

C THIS  CARD  ALSO  STIPULATES  THE  MAXIMUM  NUMBER  OF  CODES. 

C FOR  THE  8 BIT  MACHINEfIT  IS  256f  AND  FOR  THE  12  OR  16  BIT 

C MACHINE  IT  IS  4096. 

0013  MPAD=0 

0016  PP1*80 

0017  PP2-100 

0010  V=0 

0019  FR«0 

0020  N-0 

0021  CALL  ASSIGN! If 'TT1S  ') 

0022  WRITE! If  11) 

0023  11  FORMATIIXf  PLEASE  ENTER  INPUT  SOURCE  FILE  NAME') 

0024  READ ( l f 12 ) ZA 

0025  12  FORMAT <3A8> 

0026  WRITE! If  13) 

0027  13  FORMAT ! IX f 'PLEASE  ENTER  OUTPUT  OBJECT  FILE  NAME') 

0028  READ  <1f12>  ZX 

0029  CALL  ASSIGN ! 2 f ZA ) 

0030  DEFINE  FILE  2!3000f40fUfV8) 

0031  CALL  ASSIGN ! 3 f ZX ) 

0032  DEFINE  FILE  3!32f 128fUf V9> 

C FIRST  PRESCAN  FOR  LABEL  ADDRESSES. 

0033  CALL  RESCAN! DEV) 

C NOW  RETURN  TO  PRIMARY  SCAN 

0034  READ  !2'1fERR=999>  COL 

C CREATE  HEADINGS 

0033  WRITE ! 1 f 1 > 
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FORTRAN  IV  V01B-02  SAT  26-FEB-77  17129S16  PAGE  002 

C0RE=08K r UIC=C20»203  SUSAN . OB J=SUSAN . FOR/NOSN/LI J 1 

0036  1 FORMAT  < ' MPAD ' f 5X f ' CODE ' f / ) 

0037  IF  (COL  ( 7 > .EO.  QFR ) GO  TO  5 

0039  CALL  WRT(OfI) 

0040  CALL  WRT(IOfS) 

0041  GO  TO  9999 

0042  5 IF  ( COL ( 8 > .NE.  080 ) GO  TO  6 

0044  DEV=8 

0045  GO  TO  10 

0046  6 IF  (COL (9)  .NE.  020)  GO  TO  7 

0048  DEV=12 

0049  GO  TO  10 

0050  7 IF  ( COL ( 9 ) .NE.  060)  GO  TO  8 

0052  DEV=16 

0053  GO  TO  10 

0054  8 CALL  WRT(O.l) 

0055  CALL  WRT (15.5) 

0056  GO  TO  9999 

0057  10  CALL  WRT  (Orl) 

C SCAN  THE  PROGRAM-ID  CARD 

0058  READ  (2'2rERR=999)C0L 

C SQUASH  CREATES  NCOL 

0059  CALL  SOUASH 

0060  X=SCAN ( 5 f QPQ  fORQf 000 f OGO  f QRQ  f P ) 

0061  IF  (X  . EO • 1 ) GO  TO  20 

0063  CALL  WRT(OfI) 

0064  CALL  WRT ( 1 0 f 5 ) 

0065  GO  TO  9999 

0066  20  CALL  WRT(OfI) 

0067  18=3 

0068  Y=1 

0069  RECN0=1 

0070  ID7=0 

C Y CORRESPONDS  TO  THE  MPAD  VALUE  +1 

0071  30  CONTINUE 

0072  IF  (Y  .LT.  129)  GOTO  300 

C ELSE  WRITE  CODE  TO  DISK 

0074  WRITE ( 3 ' RECNO ) CODE 

0075  DO  400  G=1f 128 

0076  400  CODE(G) =* 177777 

0077  Y=1 

0078  RECN0=RECN0+1 

0079  IF  ( ID7  .EO.  0)  GOTO  300 

C ELSE  GOTO  OR  CALL  AT  BOUNDARY 

0081  CODE( 1 )=ID7 

0082  Y*»2 

0083  ID7=0 

0084  300  CONTINUE 

0085  CODE( Y)=0 

0086  READ  (2' I8fERR=99?)C0L 

0087  18=18+1 

0088  IF  (COL(l)  .EO.  OHR)  GO  TO  32 

0090  CALL  WRT(43f2> 

0091  GO  TO  30 

0092  32  IF  (DEV. EO. 8. AND.  MPAD.GE.  255)  GO  TO  35 

0094  IF  ((DEV. EO. 12. OR. DEV. EO. 16) .AND. MPAD.GE. 4096)  GO  TO  35 

0096  GO  TO  37 
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0097  35  CALL  WRT<10f2> 

0098  GO  TO  9999 

C IF# f THE  CARD  IS  ONLY  WRITTEN 

0099  37  IF  ( COL < 7 ) .NE.OCR)  GO  TO  50 

0101  CALL  URT (0*1) 

0102  GO  TO  30 

0103  50  CALL  SQUASH 

C CHECK  THE  $END  CARD 

0104  IF  < NCOL  < 1 ) . EQ . QEQ . AND . NCOL ( 2 ) . EQ . QNQ . AND . 

1NC0L (3) . EQ . QDQ. AND .NCOL (4 ) . EQ . QGR > GO  TO  55 

0106  GO  TO  60 

0107  55  CALL  URTCOfI) 

0108  CALL  URT ( 0 f 3 > 

0109  IF < N . EQ.O)  GO  TO  57 

0111  GO  TO  9999 

0112  57  WRITE ( 3 ' RECNO ) CODE 

0113  GO  TO  9999 

C CHECK  FOR  A PERIOD 

0114  60  X=SCAN  (If QER  fOfOfOfOfP) 

0115  IF  (X  .EQ.l)  GO  TO  70 

0117  CALL  WRT(OfI) 

0118  CALL  WRT ( 1 7» 5 ) 

0119  GO  TO  30 

C CHECK  FOR  A VALUE  OR  LABEL  STATEMENT 

0120  70  IF  < COL ( 8 > .EQ.QHR)  GO  TO  100 

0122  XX=SCAN(1fQDRfOfOfOfOfP> 

0123  IF  (XX. NE  1)  GO  TO  80 

0125  CALL  WRT  < 37  f 2 ) 

0126  GO  TO  30 

0127  80  IF  (NC0LC1 ) . NE . QIQ . OR . NCOL < 2 > .NE.QFQ)  GO  TO  90 

0129  CALL  URT ( 42 f 2) 

0130  GO  TO  30 

0131  90  G=SCAN(5»QVQrQAQ,QLQrQUQ.QEQ.P> 

0132  IF  < G .EQ.  1>  CALL  COLUMN(VfL) 

0134  CALL  WRT(O.l) 

0135  GO  TO  30 

C CHECK  FOR  A CONDITIONAL  STATEMENT 

0136  100  XL=SCAN<5fQVQ.QAQ.QLQ.QUQ.QEQ.P> 

0137  IF  (XL.NE.l)  GO  TO  105 

0139  CALL  WRT (41 >2) 

0140  GO  TO  30 

0141  105  F=SCAN<2fQIOfQFQfOfOfOfP> 

0142  F1=SCAN(4.QSQfQTQfQEQ.QPQ,0.P) 

0143  F2=SCAN  < 4 f Q JO. QUO f QMQ , QPQ . 0 > P > 

0144  F3=SCAN  < 4 • QEQ  r QXQ » QEQ . QCQ » 0 » P ) 

0145  F4=SCAN ( 4 f QSQ  f QKQ • QIQ . QPQ  f 0 f P ) 

0146  IF  < F . EQ . 1 . OR . FI • EQ . 1 . OR . F2 . EQ . 1 . OR . F3 . EQ • 1 • OR . 

1F4.EQ.1)  GO  TO  110 

0148  GO  TO  120 

0149  110  CALL  CONDIT 

0150  GO  TO  30 

0151  120  G=3CAN  ( 3 f QDQ f QEQ f QVQ , 0 f 0 f P > 

0152  G1=SCAN(4fQCQ.QAQ,QLQfOLQfOfP> 

0153  G2=SCAN(4fQGQfQOQ,QTQfQOQ.OfP) 

0154  IF  <G. EQ.l. OR. 01. EQ.l. OR. G2. EQ.l)  GO  TO  230 

0156  IF  ( NCOL ( 1 ) .EQ.  QBQ  .AND.NC0L(2>  .EQ.QDR)  GO  TO  150 
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0158 

GO  TO  240 

0159 

150 

IF  ( NCOL  < 3 ) . EO . 000 . OR . NCOL  < 3 ) . EO . 01 Q . OR . NCOL < 3 ) . EQ . 020 

1 • OR • NCOL ( 3 > • EQ • Q3Q . OR . NCOL (3) . CQ . 040 . OR • NCOL ( 3 ) . EQ . Q5Q 

2 . OR . NCOL  < 3 > • EO • 060 • OR • NCOL  < 3 ) . EO . Q7Q . OR • NCOL ( 3 ) • EQ . QGQ 

3 . OR . NCOL ( 3 ) . EQ . Q9Q ) GO  TO  240 

0161 

IF  < NCOL  < 3 ) . EO . QBQ . AND • ( NCOL ( 4 ) . EO . OER . OR . NCOL < 4 > . EQ . OAR 
1 .OR.  NCOL  ( 4 ) . EQ . QBR . OR . NCOL  C 4 ) .EQ.  QFC1 ) ) GO  TO  240 

0163 

IF  <NC0L<3> .EQ.QAQ.AND. (NCOL (4) . EO . Q1 Q . OR . NCOL < 4 ) .EQ.Q2Q 
1 . OR . NCOL ( 4 ) . EQ ■ Q3Q ) ) GO  TO  240 

0165 

IF  <NC0L<3> .EQ.OOQ.ANB.NCOL(4) . EQ . QNQ . AND . NCOL ( 5 ) .EQ.QEQ 
1 .AND.NC0L(6) .EQ.QSQ)  GO  TO  240 

0167 

DO  210  D=1 t 8 

0168 

S=D+2 

0169 

IF  (NCOL(S) .EQ.QER)  GO  TO  212 

0171 

210 

FVAR ( D ) =NCOL ( S > 

0172 

212 

Dl=S-2 

0173 

DO  213  I=D1 f 8 

0174 

213 

FVAR ( I ) =QHR 

0175 

DO  215  DD=1f8 

0176 

S-DB+2 

0177 

IF  < NCOL < S ) .EQ.QHR)  GO  TO  217 

0179 

215 

CONTINUE 

0180 

217 

NCOL ( S ) =QER 

0181 

DO  225  V2=l fPPI 

0182 

DO  220  S3=l f 8 

0183 

IF  < FVAR < S3 ) .NE.  VVAR<V2fS3)>  GO  TO  225 

0185 

220 

CONTINUE 

0186 

V=V2 

0187 

GO  TO  230 

0188 

225 

CONTINUE 

0189 

V=999 

0190 

230 

CALL  LITRL(VfDEV) 

0191 

C 

GO  TO  30 

CHECK  FOR  LOGIC  STATEMENTS 

0192 

240 

XV=SC AN ( 1 f ODR  f 0 f 0 f 0 f 0 f P > 

0193 

IF  (XV  .EQ.  1)  GO  TO  250 

0195 

CALL  URT  < 36  f 2 ) 

0196 

GO  TO  30 

0197 

250 

CALL  LOGIC 

0198 

GO  TO  30 

0199 

999 

N=N+1 

0200 

WRITE  Of 998 ) 

0201 

998 

FORMAT < ' ERROR  IN  A READ  STATEMENT') 

0202 

GO  TO  30 

0203 

9999 

STOP 

0204 

END 

> 'V 
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0001 

0002 

0003 

0004 

0005 

0006 


0007 

0008 

0009 

0010 


0011 


0012 

0013 


BLOCK  DATA 

L0GICAL41  VVAR.FVAR.VAR 
COMMON  /VAL/VVAR ( 80 » 8 ) » VCON  < 80 ) 

COMMON  /SJI/FVAR (8) r VAR ( 1 00 18) > CON ( 1 00 ) 

COMMON  /VAX/N  r MPAD  r FR  . Y 

L0GICAL*1  NCOL » QAQ  . GBO . OCQ . ODQ » QEG » QFO  t QGQ r QHQ .GIG. Q JO  . OKO  > QLO  > 
1QM0 i ONO  t OOQ » QPQ  r QQQ » QRQ  r QSQ  . GTQ » QUO » QVQ  * QUO  1 0X0  . OYG  r QZQ  r QOO  . 

2010  > 020 r 030 » 040 . G5Q » Q6Q  ? 070  r QOQ > Q9Q  t QAR  t OBR  r OCR  r QDR t OER » QFR » 
30GR»0HRrC0L 
COMMON  NCOL (30) 

COMMON  /PAR/PF'l  i PP2 

COMMON  /IMP/COL (80) .CODEC  128) 

COMMON  /CODES/O AG > GBQ » QCQ t QDQ . QEQ r QFO » QGO r QHO . GIG  > G JQ ► OKO » QLQ t 
10M0  > QNQ  t QOQ  > QPQ  > QQQ . GRG  r QSQ  . GTQ » QUO  t OVQ  r QUO  t QXQ  » QYD  » QZG . QOQ .010. 


2020  . 030 1 040 » 050  r Q6Q » 070  r 080 , 090 , 0 AR , OBR  r OCR » ODR , OER » QFR » QGR  . QHR 
DATA  QAQ. QBQ > QCQ  > GDQ » GEO . QFQ . OGQ t OHO .GIG. 0 JQ .QKQ.GLQfGMQ. ONQ > 000 > 
10P0  r QQQ  t ORQ  .OSG.QTQr  QUO  i QVO  t GWQ  .GXGrOYQrGZG.G0G.OlO>  020  .G30.Q40. 
2Q5Q. 060. 070. 080. G9Q .GAR  . OBR .OCR  > QDR , GER.GFR  . OGR  > OHFi/ ' A ' » 'B ' . 'C ' > 
3'D'i'E'i'F'f'G'p'H'»'rr'J'»'K'r'L'»'M'i'N'i'0'i'P'i'0'>'R'.'S'. 
4,T/t,U/»'V,f'U/»,X/»/Y'»/Z/»,0'r,l,f,2/»/3,»/4'f'5'»'6'»/7'f,8/f 
5'9'» '/ 

DIMENSION  C ( 30 ) > DCOL ( 30  > » UZ ( 30 > ,XZ<30> 

END 


FORTRAN  IV  DIAGNOSTICS 

C WARNING  3 MSG  4094  NON-STANDARD  STATEMENT  ORDERING 

FOR  — C. MAIN. 3 ERRORS!  0.  WARNINGS?  1 

> 
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0001 

0002 

0003 

■0004 


0005 

0004 

0007 

0008 

0009 

0010 
0011 
0012 
0013 


0014 

0015 
0014 

0017 

0018 

0019 

0020 

0021 

0022 

0023 

0024 
0024 

0027 

0028 

0030 

0032 

0034 

0035 
0034 

0037 

0038 

0040 

0041 

0042 


0044 

0045 
0044 

0048 

0049 


SUBROUTINE  RESCAN ( DEV ) 

IMPLICIT  INTEGER  <A-Y> 

L0GICAL41  WAR  , FVAR  , VAR 

L0GICAL41  NCOL , COL  , GAO . QBQ , QCG . GDG , QEG , QFQ , GGQ , QHG , QIG , QJQ , GKO . 

1 QLQ » GMG » GNQ  , GOG » GPG , GGQ  > GRQ , QSG  » QTQ , QUO  , GVG , GUG  > GXQ  , QYQ » GZQ , 
2G0Q,GlG,G20,G3Q,G4G,G5Q,G4G,G7Q»G8a, Q9G » GAR . GBR . GCR » QDR , QER , 
3QFRf GGRrGHR 
COMMON  NCOL (30) 

COMMON  /S  J I /FVAR  ( 8 > , VAR (100,8). CON (100) 

COMMON  /VAL/  WAR ( 80 , 8 ) . VCON ( 80 ) 

COMMON  /IMP/COL ( 80  > . CODE ( 1 28  > 

COMMON  /VAX/N.MPAD.FR.Y 
REAL*8  ZA.ZX 

COMMON  /FILE/ZA(3) .ZX(3) .RECNO 
COMMON  /PAR/PP1.PP2 

COMMON  /CODES/GAG. GBG. QCG. QDG.GEG.GFG. GGQ. GHQ. GIG, GJG. GKO. GLG, 
1QMQ,GNG,G0G,QPG,GGG,GRG,GSG,GTQ,GUG,GVG,GIJG,GXG,GYG,GZG,G0G,G1Q, 
2020, G3G, G4G, 050, 04G,G7G,G8Q,Q9G, GAR, GBR, OCR, QBR.GER.GFR.QGR, 

3QHR 

COMMON  /DSN/  V8.V9 

C FRESCAN  FOR  LABELS  AND  LABEL  ADDRESSES. 

WRITE (1,43) 

43  FORMAT ( ' WAIT  FOR  FIRST  PASS  - SCAN  FOR  LABELS') 

CCT=2 

VP=0 

L1=0 

MP=0 

C READ  SOURCE  RECORD  INTO  COL  ARRAY 

44  CCT=CCT  + 1 
DR=CCT 

AG=M0D(CCT,250) 

IF  (AG  .EG.  0)  WRITE ( 1 , 50 > CCT 
50  FORMAT (IX, 15,'  RECORDS  READ') 

READ ( 2 ' DR , ERR=999 ) COL 
C TEST  FOR  END  OF  VALUE  DECLARATIONS 
IF  (VP  .EG.  1)  GO  TO  47 
C CHECK  FOR  COMMENT 

IF  ( COL ( 7 > .EG.  GCR ) GO  TO  44 
IF  ( COL ( 8 ) .NE.  OHR)  GO  TO  44 
C FIRST  STATEMENT  FOUND.  SET  VP  FLAG 

VP=1 

C NOW  BACK  UP  TO  FIND  POSSIBLE  LABEL 
48  DR=DR-1 
CCT=CCT-1 

READ(2'DR,ERR=999)  COL 

IF  ( COL ( 7 > .EG.  GCR)  GO  TO  48 

CALL  SQUASH 

H-SCAN ( 5 , Q VG , GAO , GLG . GUG , QEG , G ) 

IF  (H  .EQ.  1)  GO  TO  47 

C LABEL  AT  MPAD=0 

C FOLLOWING  MAKES  LABEL  REFERENCE  IN  VAR  AND  CON. 

400  DO  403  H=1 , 8 
G=H 

IF  (NCOL(H)  .EG.  GER)  GO  TO  404 

403  FVAR ( H ) =NCOL ( H ) 

404  DO  410  H=G,8 


i 
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0050  410  FVAR(H)=QHR 

0051  DUP-0 


C TEST  FOR  DUPLICATE  LABEL. 

0052  IF  (LI  .Ed.  0)  GO  TO  417 

0054  DO  415  H=1 ,L1 

0055  DO  416  G= 1.8 

0056  416  IF  (FVAR(G)  .NE.  VAR(H.G) ) GO  TO  415 

0058  DUP=1 

005?  GO  TO  417 

0060  415  CONTINUE 

0061  417  IF  <DUP  .EQ.l)  GO  TO  430 

C LABEL  IS  NEW 

0063  L1=L1+1 

D WRITE (1.32)  LI 

D 32  FORMAT < 1 X » ' Ll  = ',I3> 

0064  DO  420  G=1.8 

0065  420  VAR  < L 1 > G ) =FVAR ( G ) 

0066  CO N(L1)=MP 

0067  GO  TO  44 

C IF  LABEL  IS  DUPLICATED.  WRITE  ERROR. 

0068  430  N=N+1 

006?  WRITE( 1.431)  FVAR 

0070  431  FORMAT ( ' FORMAT  ERROR  - DUPLICATE  LABEL  — ' .8A1 ) 

0071  GO  TO  44 

P NOW  ADD  MPAD  VALUES  1 OR  2 TO  MP. 

C ELIMINATE  COMMENTS 

•>072  <7  IF  < COL ( 7 ) .EO.  OCR)  GOTO  44 

0074  CALL  SQUASH 

D WRITE (1»31)(NC0L(I).I=1.8> 

D 31  FORMAT ( IX. ' NCOL  = ',A8> 

C FIND  LABELS  OR  VALUES 

0075  IF  ( COL ( 8 ) .NE.  QHR ) GOTO  480 

0077  G=SCAN (4.QCQ. QAQ . QLO . QLQ , 0 . P ) 

C FIND  CALL 

0078  IF  (G  .EQ.  1)  GOTO  440 

0080  G=SCAN ( 4 . QGQ .QOQ.GTQ. QOQ . 0 . P ) 

C FIND  GOTO 

0081  IF  (G  .EQ.  1)  GOTO  440 

0083  G=SCAN (4.QEQ. QNQ . QDQ . QGR . 0 . P > 

C FIND  END 

0084  IF  <G  .EQ.  1 ) GO  TO  4?0 

0086  MP=MP+  1 

0087  GOTO  44 

0088  440  MP=MP+1 

008?  MP=MP+1 

00?0  GOTO  44 

00?1  ???  WRITE ( 1 . 998 ) 

00?2  ??8  F0RMAT<1X, 'SOURCE  DISK  READ  ERROR') 

00?3  480  G=SCAN  < 5 . QVQ . QAQ » QLQ , QUQ . QEQ . P ) 

00?4  IF  < G .EQ.  1)  GOTO  44 

00?6  GOTO  400 

00?7  4?0  PP2=L1 

D WRITE ( 1,30) <(VAR( I, J) .J=l,8>. 1=1 .PP2) 

D 30  FORMAT ( 1 X, 80A 1 ) 

00?8  RETURN 

00??  END 
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0001 


0002 

0003 


0004 

0005 

0006 

0007 

0008 

0009 

0010 
0011 
0012 
0013 


0014 

0015 

0016 

0017 

0018 
0020 
0021 
0022 

0023 

0024 

0025 

0026 

0027 

0028 
0029 

0031 

0032 


INTEGER  FUNCTION  SCAN ( A » B » C » D * E . F » J) 

C SCAN  IS  USED  TO  CHECK  FOR  RESERVE!'  WORDS  OF  THE  MDMPL  LANGUAGE 

C DEPENDING  ON  THE  VALUE  OF  A .SCAN  WILL  CHECK  FOR  A CHARACTERS 

C IF  SCAN  COMES  BACK  WITH  A VALUE  OF  1 .THEN  THE  TEST  UAS  SUCCESSFUL 

IMPLICIT  INTEGER  (A-Y) 

L0GICAL*1  G . OAG . OBQ . OCO  » ODO. OEQ . QFO » QGQ » OHO . 0 1 0 . 0 JO . OKQ . OLQ » 

10M0.  ONO.  000.  QF'Q.  000.  ORQ . OSO . OTQ . OUQ . QVQ . QWO . 0X0.  Q YO.OZO.  000, 010  f 
2020 .030.040. 050 . 060 . 070 . 080 . 090 . OAR . OBR . OCR . GDR . QER . OFR . OGR . 

3QHR . B . C . D . E . F . COL  . WAR . FVAR , VAR 
COMMON  G ( 30 ) 

COMMON  /VAL/VVAR < 80 . 8 ) . VCON  < 80 ) 

COMMON  /F'AR/F'F'l  »FP2 

COMMON  /SJI/FVAR(8) .VAR( 100.8) .CON( 100) 

COMMON  /IMP/C0L<80)..C0DE<  128) 

COMMON  /VAX/  N.MPAD.FR.Y 
REAL*8  ZA.ZX 

COMMON  /FILE/ZA ( 3 ) . ZXC 3 ) » RECNO 
COMMON  /DSK/V8.V9 

COMMON  /CODES/QAQ.OBO. OCO. ODO. QEO.OFQ.OGO. OHO. 0 1 0.QJQ.OKO.QLO, 

1 OMQ . ONO . 000 . OPO . 000 . ORQ . OSO . 0 TO . QUO . OVO . OUQ . 0X0 . 0 YQ . OZO . 000 . 0 1 0 . 
2020 . 030 . 040 . 050 . 060 . 070 . 080 . 090 . OAR . OBR . OCR . ODR . OER . OFR . OGR . OHR 
D WRITE  ( 1 . 60 )A»B»C.D.E.F 

D60  FORMAT  ( IX . ' A= ' . I 1 > ' B='»A1.'  C='.A1»'  D='.A1»'  E='.A1>'  F='.A1) 
GOTO  <1.2. 3. 4. 5)  A 
RETURN 

1 DO  10  J=1 » 30 
I=J 

IF  <G< J>  .EO.  B)  GOTO  15 
10  CONTINUE 

J=0 

SCAN=0 
RETURN 
15  SCAN= 1 

J=I 

RETURN 

2 DO  20  J=1 .29 
I=J 

IF  (G( J) ,EO.B.AND.G< J+l ) .EO.  C)  GOTO  25 
20  CONTINUE 

J=0 


0033 

0034 

0035  25 

0036 

0037 

0038  3 

0039 

0040 

0042  30 

0043 

0044 

0045 

0046  35 

0047 

0048 

0049  4 


SCAN=0 
RETURN 
SCAN=1 
J=I  + 1 
RETURN 

DO  30  J= 1 . 28 
I=J 

IF  < G < J ) .EO . B . AND . G<  J+l ) . EO . C . AND . G < J+2 ) . £0. D)  GOTO  35 

CONTINUE 

J=0 

SCAN=0 
RETURN 
SCAN  -1 
J=I  + 2 
RETURN 

DO  40  J=1 . 27 
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I = J 

IF  <G<  J ) . EQ . B . AND . G ( J+ 1 ) . EQ . C . AND . G < J+2 ) . EQ . D . AND . G ( J + 3 ) . EC) . E ) 
1G0T0  40 
CONTINUE 
J=0 

SCAN=0 
RETURN 
SCAN^l 
J-l  + 3 
RETURN 

HO  50  J-1.26 
I = J 

IF  ( G( J ) . EG . B . AND. G < J+l ) . EQ . C . AND . G ( J+2 ) . EQ . D . ANH . G ( J+3 ) . EQ . E 
l.AND.GC J+4).EQ.F>  GOTO  55 
CONTINUE 
J -0 

SCAN=0 
RETURN 
SCAN  - 1 
J = I + 4 
RETURN 
END 
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0001 

0002 

0003 

0004 


0005 

0006 

0007 

0008 

0009 

0010 
0011 
0012 
0013 


0014 

0015 

0016 

0017 

0018 

0019 

0020 
0021 
0022 


C 

1 

9 

C 

2 

6 

C 


0023 

0024 

0025 

0026  5 
0028 

0029  11 

0030 

0031  12 

0033 

0034  13 

0035 

0036  50 

0038 

0039  55 

0040 

0041  60 

0043 

0044  65 

0045 

0046  70 

0048 

0049  75 

0050 

0051 

0053 

0054  85 


80 


SUBROUTINE  URT ( VARF f PCK > 

IMPLICIT  INTEGER  (A-0) 

IMPLICIT  INTEGER  (G-Y) 

LOGICALtl  COL  * NCOL , QAQ  , QBQ , QCQ , QDQ , QEQ , QFQ , GGQ » QHQ  , QIQ , Q JQ  , QKQ  , 

1 QLQ , QMQ » ONQ , 000  > QF'Q , QQQ  f ORQ  , QSO , QTQ , QUO  t 0 VQ > QUO  fGXQfQYGf QZO , 

2Q00 fQIGf 020 » 030  , 040 , 050  > 060  , 070 , 080 , 09Q , OAR  , QBR t OCR  > QDR  > 

3QER , QFR f OGR  f OHR 
L0GICAL*1  VVARfFVARfVAR 
COMMON  /IMP/COL ( 80 ) f CODE ( 128 ) 

COMMON  NCOL (30) 

COMMON  /VAL/  WAR  ( 80 f 8 ) f VCON ( 80 ) 

COMMON  /PAR/PF‘1  fPP2 

COMMON  /SJI/  FVARC8) f VAR ( 100 f8) f CON (100) 

REAL*8  ZAfZX 

COMMON  /FILE/ZA(3) fZX(3) fRECNO 

COMMON  /CODES/QAQ  f QBO f OCQ f ODQ f OEO f OFQ f QGQ  f QHQ f QIQ  f QJQ f QNO  f OLQ f 
1QMQ f QNQ, OOQ f QF'Q, OQQ. QRQ f QSQ f QTQf QUO. QVOfOUQfQXQfOYOfOZQfQOOf QIQ, 
2020 , 030 , 040 , 050 , Q6Q , 070 , Q8Q , Q9Q , QAR , QBR , QCR , QDR , QER , QFR , QGR , QHR 
COMMON  /VAX/NfMPADfFRf Y 
COMMON  /DSK/  V8,V9 
GO  TO  (1f2f3,4f5)  fPCK 
WRITE  CARD  ONLY 
WRITE  (1f9)(C0L(I)fI=1f80) 

FORMAT ( 20X , 80A1 ) 

RETURN 

WRITE  ADDRESS, CODE, CARD  AND  ERROR  MESSAGE 
CODE ( Y ) =32767 

WRITE  ( 1 f 6 ) MPAD f CODE ( Y ) , ( COL ( I ) , I = 1 , 80 ) 

FORMAT ( 1 X , 05 , 4X , 05 , 5X , BOA  1 ) 

PRINT  ERRORS  CORRESPONDING  TO  VARF 
N=N+1 

MPAD=MPAD+1 

Y=Y+1 

IF  (VARF  .NE.  10)  GO  TO  12 
WRITE  ( 1 , 1 1 ) 

FORMAT ('  FORMAT  ERROR-CARD  PROCEDURE'  ) 

RETURN 

IF  (VARF  .NE.15)  GO  TO  50 
WRITE  ( 1 , 1 3 > 

FORMAT ('  FORMAT  ERROR-CONTROL  CARD'  ) 

RETURN 

IF  (VARF  .NE.  16)  GO  TO  60 
WRITE  (If  55 ) 

FORMAT ( ' FORMAT  ERROR-OVERFLOW'  ) 

RETURN 

IF  (VARF  .NE.  17)  GO  TO  70 
WRITE  (1, 65 ) 

FORMAT  ('  FORMAT  ERROR-  NO  PERIOD'  > 

RETURN 

IF  (VARF  .NE.  18)  GO  TO  80 
WRITE  ( 1 , 75 ) 

FORMAT ( ' FORMAT  ERROR-MISCELLANEOUS'  ) 

RETURN 

IF  (VARF  .NE.  19)  GO  TO  87 
WRITE  (1,85) 

FORMAT  ('  FORMAT  ERROR-  NO  CONDITION  SELECT'  ) 
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0055  RETURN 

0056  87  IF  (VARF  .NE.20)  GO  TO  90 

0058  WRITE  ( 1 r 88> 

0059  88  FORMAT < ' FORMAT  ERROR-INVALID  CHARACTER'  ) 

0060  RETURN 

0061  90  IF  (VARF  .NE.  21)  GO  TO  100 

0063  WRITE  ( 1 » 95) 

0064  95  FORMAT ('  FORMAT  ERROR-  NO  TRUE  SUCCESSOR'  ) 

0065  RETURN 

0066  100  IF  (VARF  .NE.  23)  GO  TO  110 

0068  WRITE  (1.105) 

0069  105  FORMAT ( ' FORMAT  ERROR-  UNDEFINED  VALUE  CONSTANT'  > 

0070  RETURN 

0071  110  IF  (VARF  .NE.  24)  GO  TO  120 

0073  WRITE  (1.115) 

0074  115  FORMAT  ('  FORMAT  ERROR-  MISSING  DIGIT  AFTER  DEV'  > 

0075  RETURN 

0076  120  IF  (VARF  .NE.  25)  GO  TO  130 

0078  WRITE  (1.125) 

0079  125  FORMAT  ('  FORMAT  ERROR-  MISSING  DIGIT  AFTER  LC'  ) 

0080  RETURN 

0081  130  IF  (VARF  .NE.  26)  GO  TO  140 

0083  WRITE  (1.135) 

0084  135  FORMAT  ('  FORMAT  ERROR-  MISSING  DIGIT  AFTER  BEX'  ) 

0085  RETURN 

0086  140  IF  (VARF  .NE.  31)  GO  TO  150 

0088  WRITE  (1.145) 

0089  145  FORMAT ( ' FORMAT  ERROR-  MISSING  DIGIT  AFTER  OUT'  ) 

0090  RETURN 

0091  150  IF  (VARF  .NE.  32)  GO  TO  160 

0093  WRITE  (1.155) 

0094  155  FORMAT ( ' FORMAT  ERROR-  NO  DESTINATION  SELECT'  > 

0095  RETURN 

0096  160  IF  (VARF  .NE.  33)  GO  TO  170 

0090  WRITE  (1,165) 

0099  165  FORMAT  ('  FORMAT  ERROR-  MISSING  DIGIT  AFTER  A'  > 

0100  RETURN 

0101  170  IF  (VARF  .NE.  34)  GO  TO  180 

0103  WRITE  (1,175) 

0104  175  FORMAT  ('  FORMAT  ERROR-  UNDEFINED  SEMANTICS'  ) 

0105  RETURN 

0106  180  IF  (VARF  .NE.  35)  GO  TO  186 

0108  WRITE  (1,185) 

0109  185  FORMAT  ('  FORMAT  ERROR-  UNDEFINED  OPERATION'  > 

0110  RETURN 

0111  186  IF  (VARF  .NE.  36)  GO  TO  188 

0113  WRITE( 1,187) 

0114  187  FORMAT  ('  FORMAT  ERROR-  NO  EQUAL  SIGN'  ) 

0115  RETURN 

0116  188  IF  (VARF  .NE.  37)  GO  TO  190 

0118  WRITE  (1,189) 

0119  189  FORMAT ( ' FORMAT  ERROR-  NO  LOGIC  STATEMENT  IN  COLUMN  8'  ) 

0120  RETURN 

0121  190  IF  (VARF  .NE.  40)  GO  TO  196 

0123  WRITE  (1,195) 

0124  195  FORMAT  ('  FORMAT  ERROR-  VALUE  CONSTANT  OVERFLOW'  ) 
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0125 

0126  196 
0128 

0129  197 

0130 

0131  198 

0133 

0134  199 

0135 

0136  220 

0138 

0139  225 

0140 

0141  200 

0143 

0144  205 

0145 

0146  210 

0147  250 

0148 

C 

0149  3 

0150  7 

0151 

C 

0152  4 

0153  8 

0154 

0155 

0156 

0157 


RETURN 

IF  ( VARF  .NE.  41 > GO  TO  198 
WRITE  (1.197) 

FORMAT ('  FORMAT  ERROR-  VALUE  STATEMENT  ONLY  IN  COLUMN  8'  > 
RETURN 

IF  (VARF  .NE.  42)  GO  TO  220' 

WRITE  (1,1 99 ) 

FORMAT < ' FORMAT  ERROR-  NO  CONDITION  STATEMENTS  IN  COLUMN  8'  ) 
RETURN 

IF  (VARF  .NE.  43)  GO  TO  200 
WRITE  (1.225) 

FORMAK'  FORMAT  ERROR-  NO  STATEMENTS  BEGIN  IN  COLUMN  1'  ) 
RETURN 

IF  (VARF  .NE.  45)  GO  TO  210 
WRITE  (1,205) 

FORMAT ('  FORMAT  ERROR-  NO  FALSE  SUCCESSOR'  > 

RETURN 

WRITE ( 1 . 250 ) VARF 

FORMAT (IX, 016, ' IS  NOT  A VALID  NUMBER  FOR  VARF'  > 

RETURN 

LAST  WRITE-WRITE  THE  NUMBER  OF  ERRORS 
WRITE  ( 1 , 7)N 

FORMAT ('  THE  NUMBER  OF  ERRORS* ' ,12) 

RETURN 

WRITE  THE  ADDRESS  AND  CODE  WITH  THE  CARD 
WRITE  (1,8) MFAD , CODE ( Y > . ( COL ( I ) . I = 1 , 80 ) 

FORMAT  (IX, 05 »4X,05,5X» 80 A 1 ) 

MPAD=MF'AD+ 1 
Y=Y+1 
RETURN 
END 
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0001  SUBROUTINE  SQUASH 

0002  IMPLICIT  INTEGER  (A-Y) 

0003  LOGICAL* 1 COL  r NCOL f OAQ . OBQ  f QCQ . QUO . QEO f QFQ . QGQ f QHQ  f Q I Q f Q JO  f QKQ  f 
10L0  f OhQ  f QNQ f QOQ , QPQ  f QQO  f QRQ  f QSQ  f OTQ  f QUQ  f QVQ  f QUO  f QXQ  f Q YQ  f QZQ  f 
2Q0Q. Q1 Q f GPO f G3Q. Q4Q, 050 .Q6Gf 070.080, 090 fQARfQBRf OCR fQDRfOERf 
3QFR  f OGR  f OHR 

0004  COMMON  NCOL (30) 

0005  COMMON  /IMP/COL <80 ) fCODE( 128 ) 

0006  COMMON  /CODES/QAO f QBO f QCQ f QUO f OEQ f OFO f QGQ f QHQ fQIQf Q JO f QKQ fQLQf 
IQMQfQNQfQOQfOPQfOOO  CROfOSQfQTQfQUOfQVQfQWQfQXQfQYQfQZQfQOQfQIQf 
202Q f 030 f Q4Q » Q5Q f Q6Q f Q7Q f Q8Q f Q9Q f QAR fOBRf QCR f QDR f QER f QFR f QGR f QHR 

0007  J=1 

0008  no  20  1=1 F 80 

C THIS  CHECKS  FOR  A SPACEfIF  THERE  IS  ONEf  IT  WILL  IGNORE  IT 

0009  IF  ( COL ( I > . EQ . QHR ) GOTO  20 

C THIS  ASSIGNS  THE  CHARACTER  TO  THE  NEW  ARRAY 

0011  NCOL ( J) =COL ( I ) 

0012  J=J+1 

C EVERYTHING  AFTER  A PERIOD  IS  IGNORED 

0013  IF  (COL( I ) . EQ.QER)  GOTO  30 

0015  20  CONTINUE 

0016  30  K=J 

C THIS  IS  A CHECK  TO  SEE  THAT  THE  STATEMENT  BEFORE 
C THE  PERIOD  IS  NOT  TOO  LONG 

0017  IFCK.GT. 29 > GOTO  60 

C THIS  IGNORES  EVERYTHING  AFTER  THE  FIRST  PERIOD 

0019  DO  50  A=Kf30 

0020  50  NCOL  (A)=QHR 

0021  RETURN 

0022  60  CALL  URT(16f2) 

0023  RETURN 

0024  END 
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COLUMN  (cont  ) 


0.  1.  2.  3.  4.  5 
\6,  7.  8 or  9/ 


AC  = DCCL(K) 
B = K ♦ 1 


/ WRITE  MPAD, 
Yes/  CODE(Y),  COL 
>-  W and  "Format 

/ Error  - l ndefined 
/ Value  Constant" 


V = V - 1 
N * N + 1 

Y * Y + 1 

MPAD  MPAD  * 1 


(return) 


AC  = DCOL(K)  * 10 
+ DCOL(B) 

F = B + 1 


! A = 1.0 

i 

C(A ) : IS 

iCOL(A ) 

F = Q,  15 

C(F) 

= "a" 

E = 1. 8 

\ 

VVAR/V, 

E>  = C(E) 

VCON(V)  = AC 


AC  = DCOL(K)  * 100 
+ DCOL(B)  * 10 
+ DCOL(F) 

I G = F + 1 


NCOL(GP 

4 


/WRITE  MPAD. 

I CODE(Y),  COL 
and  "Format 
Error  - Value 
Constant 
Overflow" 


No  / \ Yer; 

I V'CON(V)  = AC  L < AC  > 255  >— J 


V 

V - 1 

N 

N + 1 

Y 

Y + 1 

M PAD 

MPAD  * 1 

(RETURN) 


Figure  1-5.  (Cont.) 
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I 

I 

I 

I 


0001 

0002 

0003 

0004 


0005 

0006 

0007 

0008 

0009 

0010 


0011 

C 

0012 

0013 

C 

0015 

0016 

0017 

0018 

0020 

0022 

0023 

0024 

6 

0026 

0027 

0028 

7 

0030 

0031 

0032 

8 

0034 

0035 

0036 

9 

0038 

0039 

0040 

11 

0042 

0043 

0044 

12 

0046 

0047 

0048 

13 

0050 

0051 

0052 

14 

0054 

0055 

0056 

17 

0058 

0059 

15 

SUBROUTINE  COLUMN(U.L) 

IMPLICIT  INTEGER  (A-Y) 

L0GICALK1  UUAR.FOAR. UAR.C 

L0GICAL*1  COL . NCOL  , QAQ  , QUO  » OCQ  . QDQ . QEO . GFO » QGQ . QHQ .010. 0 JO , QKQ . 

1 QLO . OMQ .ONO.OOQ. OF'Q .OOO.QRO.QSO.OTO. OUO .OUQ.OWQ.OXQ.OYQ.OZQ, 
2000. 010. 020. 030. 040. 05Q. 060. 070. Q80. 090. OAR. QBR. OCR. ODR.QER. 
3QFR.QGR.0HR 
COMMON  NCOL (30) 

COMMON  /UAL/  UUAR ( 80 . 8 ) . UCON ( 80 ) 

COMMON  /SJI/  FUARL8) .UAR( 100.8) .CON( 100) 

COMMON  /IMP/  C0L(80) .C0DEC128) 

COMMON  /UAX/N  , MF'AD  . FR  . Y 

COMMON  /CODES/QAQ . QBG . QCQ . ODD . OEO .OFO.OGO.OHO.OIO. QJO . QKO » QLO . 
10M0 . QNQ .OOO.OF'O.OQO.QRQ.QSQ.OTQ.OUO.OUO.OUJO.OXQ.OYQ.OZO.QOa.OlO. 
2020 . 030 , 040 , 050 . Q60 , 070 . 080 , Q9Q . QAR . OBR . OCR . OBR , QER . QFR . QGR , OHR 
DIMENSION  C ( 1 5 ) . DCOL ( 30 ) 

CHECK  TO  SEE  IF  IT  IS  A UALUE  STATEMENT 
X=SCAN  < 5 , OUO , OAO . OLO , OUO , OEO , I ) 

IF  (X  .EG.  0)  GOTO  70 

CHANGE  FROM  HOLLERITH  TO  DECIMAL 

K=I  + 1 

KN=I+4 

DO  15  J=K»KK 

IF  (NCOL(J) .EQ.OER)  GOTO  16 
IF  (NCOL(J)  .NE.  010)  GOTO  6 
DCOL ( J ) =1 
GOTO  15 

IF  (NCOL(J) .NE.02Q)  GOTO  7 
DCOL (J) =2 
GOTO  15 

IF  (NCOL(J).NE.  Q3Q)  GOTO  8 
DCOL( J>=3 
GOTO  15 

IF  (NCOL(J).NE.  04Q)  GOTO  9 
DCOL ( J ) =4 
GOTO  15 

IF  ■( NCOL ( J ) .NE.  050)  GOTO  11 
DCOL (J) =5 
GOTO  15 

IF  < NCOL ( J ) .NE.  060)  GOTO  12 
DCOL ( J > =6 
GOTO  15 

IF  ( NCOL ( J ) . NE . 070  > GOTO  13 
DCOL ( J ) =7  • 

GOTO  15 

IF  (NCOL(J)  .NE.  Q8Q)  GOTO  14 
DCOL ( J) =8 
GOTO  15 

IF  (NCOL(J).NE.  090)  GOTO  17 
DCOL ( J > =9 
GOTO  15 

IF  ( NCOL ( J > . NE . 000 > GOTO  60 

DCOL ( J ) =0 

CONTINUE 


C ADUANCE  LOOP  NUMBER  BY  1 

0060  16  U=V+1 
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C 


0061 

0062 

0063 

0064 

10 

0065 

0066 

20 

0067 

0068 

30 

* 

D 

0069 

D31 

C 

0071 

0072 

0073 

0075 

0076 

0077 

0079 

0080 

C 

0081 

0083 

C 

0085 

40 

C 

0086 

c 

0087 

50 

0088 

c 

0089 

0090 

0091 

60 

0092 

0093 

0094 

C 

0095 

70 

C 

0096 

0097 

0098 

0100 

80 

0101 

83 

0102 

84 

C 

0103 

0104 

0105 

FIND  VARIABLE  BEFORE  VALUE  STATEMENT 

D=I-5 

0=1-4 

DO  10  A=1 » D 
C < A) =NC0L  ( A > 

DO  20  F=G » 15 
C(F)=QHR 
DO  30  E=1 » 8 
VVAR( V.E>=C(E) 

WRITE  ( 1 . 31 > ( WAR (V»E).E=1.8) 

FORMAT  ('  VVAR= ' » A8 ) 

FIND  CONSTANT  AFTER  VALUE  STATEMENT 

IF  < DCOL (K  > • NE . 0 • AND • DCOL ( K ) . NE . 1 . AND . DCOL ( K ) . NE . 2 • AND . DCOL  < K > . NE . 3 

1 .AND . DCOL  <K ) . NE . 4 . AND . DCOL  ( K > . NE . 5 . AND . DCOL  ( K ) . NE . 6 . AND . DCOL  ( K ) 

2 • NE  • 7 .AND  .DCOL  <K ) .NE . 8.  AND.  DCOL  (K ) . NE . 9 ) GOTO  50 
AC=DCOL  (K ) 

B=K+1 

IF  (NCOL(B).EC).  OER)  GOTO  40 
AC=DC0L(K)*10+DC0L(B> 

F=B+1 

IF  (NCOL(F) .EO.QER)  GOTO  40 
AC=DCOL  (K)#100+DC0L(B  > +DCOL  < F > 

G=F+1 

THESE  ARE  OVERFLOW  CHECKS 
IF  (NCOL  ( G > . NE . QER ) GOTO  60 
IF  (AC.GT.255)  GOTO  60 

THIS  WILL  ASSIGN  THE  CONSTANT  TO  THE  PROPER  ARRAY 
VCON ( V ) =AC 

THIS  WILL  WRITE  THE  CARD 
RETURN 

THIS  WILL  WRITE  THE  OVERFLOW  ERROR  CHECKED  FOR  ABOVE 
CALL  WRT (0.1) 

CALL  WRT (23. 5) 

BECAUSE  OF  AN  ERROR. THE  VALUE  LOOP  NUMBER  IS  SUBTRACTED  BY  1 

V=V-1 

RETURN 

CALL  WRT ( 0 . 1 > 

CALL  WRT (40.5) 

V=V-1 

RETURN 

THIS  IS  THE  LABEL  LOOP  NUMBER  ADDER 
L=L+1 

THIS  WILL  ASSIGN  THE  VARIABLE  INTO  THE  PROPER  ARRAY 

DO  80  H=1 .8 

G=H 

IF  (NCOL(H)  .EQ.  OER)  GOTO  83 
VAR ( L . H ) =NCOL ( H ) 

DO  84  J=G.8 
VAR(L. J)=QHR 

THIS  WILL  ASSIGN  THE  CONSTANT  TO  THE  CORRESPONDING  VARIABLE 

CON (L ) =MPAD+1 

RETURN 

END 


C’ODE(V)  ^ 4*2*1 


WRITE  MAPD, 
CODE(Y),  COL  and 
"Format  Error  - 
Invalid 
Character" 


WRITE  M PAD, 
CODEC  Y),  COL 
and  "Format 
Error  - I'ndefined 
Semantics" 


NCOLC5),  NCOL‘101 


CODE(Y)  = 
CODEC Y)  * 25G 
* 128 
* 32 


WRITE  MPAD, 
CODEC  Y>,  COL 
and  "Format 
Error  - Undefined 


RETURN 


CONDIT  (cont.) 
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0001 

0002 

0003 


0004 

0005 

0006 
0007 


D 

01 

C 

0008 

0009 

0010 
0011 
0012 

0013 

D 

02 

0014 
0016 

0018 

0019 

C 

0021 

0022 

0024  5 

0025 

0026  10 
0027 

C 

0029 

0030 

0032 

0033  20 

0034 

C 

0036 

0037 

0039 

0040  30 

0041 

C 

0043 

0044 

0046 

C 

0047  40 

0048 
0050 


SUBROUTINE  CONDIT 

CONDIT  CHECKS  FOR  THE  CONDITION  TESTS 
IMPLICIT  INTEGER  <A-Y> 

L0GICAL41  COL  f NCOL  fGAQ f GBG  f GCG  f GDG  f QEQ  f QFGf  QGG  fQHG  f GIG  f Q JQ f GKG f 
lQLOFQMQFQNQFOOQFQF'aFQQQFORQFQGQFQTaFOUQFQVQFQUQFQXQFOYaFQZQF 
2000 f Q1 G f Q2G f 03Q. G4QfQ5Q.Q6QfQ7QfQ8QfG9QfQARfQEiRf OCR fQDRf 
30ERfQFRfQGRfGHR 
COMMON  NCOL (30) 

COMMON  /IMP/COL ( 80 ) f CODE ( 1 28 ) 

COMMON  /VAX/  NfMFADfFRfY 

COMMON  /CODES/GAO  f GDG  f GCG  f GDG  f GEO , GFG f QGG  f GHG  f GIG  f G JQ  f QKG  f GLQ  f 
lQMOFGNQFGOGFGPGFGGQFQRGFGSGFGTQFGUGFGVGFGUQFGXQFGYGFDZGFGOaFQlGF 
2020 1 030  f 040  f G5Q  f 06Q  f G7Q  f GOG f Q9Q f Q AR  f GBR  f GCR  f QDR  f GER  f QFR  f QGR  f QHR 
WRITE  <1f1>  NCOL 
FORMAT  (IXf 'NCOL=' f30A1) 

SET  BITS  14-16 
CODE ( Y) =4+2+1 
W=0 

R3=SCAN(1 fOERfOfOfOfOfD) 

R=SCAN< 1 fGDRfOfOfOfOfP) 

R1 =SCAN ( 1 f OAR  f 0 f 0 f 0 f 0 f P ) 

R2=SCAN( IfGBRfOfOfOfOfP) 

WRITE  < 1 f2)  QfRfRI fR2 

FORMAT  (1Xf'Q='fI1f'R='fI1f'  Rl='rll,'  R2='fI1> 

IF  <R. EO.l. OR. Rl. EG. 1. OR. R2. EG. 1)  GOTO  520 

IF  ( Q . NE . 5 . AND . G . NE . 1 0 . AND . 0 . NE . 1 6 . AND . G . NE . 1 8 . AND . 0 . NE . 24 ) 

1G0T0  530 

X=SCAN(4fQSGfGTGfGEGfQPGf0fK> 

IF  (K  .NE.  4)  GOTO  10 

SET  BITS  8-9 

CODE ( Y ) =CODE  ( Y > +256+ 1 28 

IF  < NCOL ( 5 ) .EG.  GER)  GOTO  510 

CALL  WRT (34  f 2 ) 

RETURN 

X=SCAN ( 4 f G JO  f GUG . GMG f GPG  fOfL) 

IF  (L.NE.  4)  GOTO  20 
SET  BITS  8f9,11fI3 
C0DE(Y)=C0DE(Y>+256+ 128+32+8 
IF  (NC0L<5) .EG. GER)  GOTO  510 
GOTO  5 

X=SCAN(4F0SGFGKGFGiaFQPGF0FLl) 

IF  (L1.NE.4)  GOTO  30 

SET  BITS  8- 1 0 f 1 2 

CODE  < Y ) =CODE ( Y ) +256+ 128+64  + 16 

IF  (NCOL (5 ) .EG.  GER)  GOTO  510 

GOTO  5 

X=SCAN ( 4 f GEG  f GXG f GEG  f GCG  f 0 f L2  > 

IF  (L2.NE.  4)  GOTO  40 
SET  BITS  8-13 

CODE(Y)=CODE(Y) +256+128+64+32+16+8 
IF  (NCOL (5)  .EQ.QER)  GOTO  510 
GOTO  5 

CHECK  FOR  RESERVED  WORDS  IN  COLUMNS  3-5 
X=SCAN<3fGMGfGS0.GTGf0.0.L3) 

IF  (L3  .EQ.  5)  GOTO  200 
X=SCAN ( 3 f GAG  f GOG  f GVG . 0 f 0 f L4 ) 
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0051 

IF  <L4  .NE.  5)  GOTO  50 

C 

SET  BIT  7 

0053 

CODE  < Y )=CODE ( Y ) +512 

0054 

GOTO  200 

0055 

50 

X=SCAN < 3 . OLO , OSQ . QTO . 0 . 0 . L5 ) 

0056 

IF  (L5.NE.5)  GOTO  60 

C 

SET  BIT  6 

0058 

CODE ( Y ) =CODE (Y)+1024 

0059 

GOTO  200 

0060 

60 

X=SCAN<  3 . QAO . GBQ , QTO . 0 . 0 . L6 ) 

0061 

IF  <L6  .NE.  5)  GOTO  70 

C 

SET  BITS  6-7 

0063 

CODE  < Y ) =COD£  < Y ) + 1024+512 

0064 

GOTO  200 

0065 

70 

X=SCAN (3.GEG.GXQ.GTG.0.0.L7) 

0066 

IF  <L7  .NE.  5)  GOTO  80 

C 

SET  BITS  5-7 

0068 

CODE< Y>=CODE(Y) +2048+1 024+51 

0069 

GOTO  200 

0070 

80 

X=SCAN < 2 . OLG . GCG . 0 . 0 . 0 . L8  > 

0071 

IF  (L8  .EG. 4)  GOTO  90 

0073 

CALL  WRT(19.2> 

0074 

RETURN 

C 

0075 

0077 

90 

OC  78 
0079 
0081 
0082 

601 

0083 

0085 

602 

0086 

0088 

610 

0089 

95 

0090 

C 

0091 

100 

0092 

C 

0093 

110 

0094 

C 

0095 

120 

C 

0096 

0098 

200 

0100 

0101 

0102 

701 

0104 

0105 

0106 

702 

0108 

0109 

0111 

710 

CHANGE  HOLLERITH  TO  DECIMAL 
IF  ( NCOL ( 5 ) .NE.  010)  GOTO  601 
UZ=1 

GOTO  610 

IF  ( NCOL ( 5 ) .NE.  020)  GOTO  602 

WZ=2 

GOTO  610 

IF  ( NCOL  1 5 ) . NE . 030 ) GOTO  610 
UZ=3 

IF  (WZ.GT.3.0R.UZ.LT.1)  GOTO  95 
GOTO  < 100 .110.120) . WZ 
CALL  URT ( 25  r 2 ) 

RETURN 
SET  BIT  5 

CODE ( Y>  =CODE ( Y) +2048 
GOTO  200 
SET  BITS  5.7 

CODE(Y)=CODE(Y> +2048+512 
GOTO  200 
SET  BITS  5-6 

CODE <Y)=CODE(Y) +2048+1024 
CHANGE  COLUMN  11  TO  DECIMAL 
IF  ( NCOL ( 2 ) . NE . QFQ)  GOTO  5 
IF  < NCOL (11)  .NE.  01Q)  GOTO  701 
XZ=1 

GOTO  710 

IF  < NCOL (11)  .NE.  Q2Q>  GOTO  702 
XZ=2 

GOTO  710 

IF  ( NCOL (11)  .NE.  Q30)  GOTO  710 
XZ=3  " 

IF  (XZ.LT.l .0R.XZ.GT.3)  GOTO  205 
GOTO  (230.220.210) .XZ 
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C 

SET  BITS  8-9 

0112 

205 

CODEC Y)=C0DECY>+256+128 

0113 

GOTO  230 

C 

SET  BIT  8 

0114 

210 

CODEC Y)=CODECY> +256 

0115 

GOTO  230 

C 

SET  BIT  9 

0116 

220 

CODE  C Y ) =CODE  C Y ) + 128 

0117 

230 

X=SCAN  C 4 . OSO » QTQ  f beq , OPO ,0,J1> 

C 

CHECK  FOR  "STEP'  IN  COLUMNS  6-9  OR  12-15 

0118 

IF  CJ1  .NE.  9. AND.  J1  .NE.  15)  GOTO  240 

0120 

GOTO  350 

C 

SAME  WITH  "JUMP1  OR  *EXEC* 

0121 

240 

X 1 =SCAN  C 4 . 0 JO  > QUO . QMO . OPQ . 0 . J2 ) 

0122 

IF  CJ2  .NE.  9 .AND.  J2  .NE.  15) .GOTO  250 

C 

SET  BIT  11 

0124 

CODE  C Y ) =CODE  C Y ) +32 

0125 

W=8 

0126 

GOTO  300 

0127 

250 

X2=SCAN ( 4 . QSQ . OKQ . 0 I 0 . OPO . 0 . J3 ) 

0128 

IF  CJ3  .NE.  9. AND.  J3  .NE.  15>  GOTO  260 

C 

SET  BIT  10 

0130 

CODE  C Y > =CODE  C Y ) +64 

0131 

W«16 

0132 

GOTO  300 

0133 

260 

X3=SCAN C 4 . QEQ » QXQ . QEB . OCQ . 0 > J4 ) 

0134 

IF  CJ4  . EG . 9. OR.  J4  ,E0.  15)  GOTO  270 

0136 

CALL  URT (21 >2) 

C137 

RETURN 

C 

SET  BITS  10-11 

0138 

270 

CODEC Y)=CODECY> +64+32 

0139 

W=16+8 

0140 

300 

IF  CX.EO.  0>  GOTO  350 

0142 

GOTO  510 

0143 

350 

X4=SCAN  C 4 , 0 JO . QUO . QMO . OPQ  r 0 . J5  > 

0144 

IF  CX4.E0.0)  GOTO  370 

0146 

IF  C J5.EQ.9.0R. J5.E0. 15)  GOTO  370 

C 

SET  BIT  13 

0148 

CODEC Y>=C0DE(Y>+8 

0149 

GOTO  510 

0150 

370 

X5=SC AN  C 4 . OSO . OKQ . 0 1 0 » QPQ . 0 . J6  > 

0151 

IF  CX5.EQ.0)  GOTO  400 

0153 

IF  C J6.E0.9.0R. J6.EQ. 15)  GOTO  400 

C 

SET  BIT  12 

0155 

CODE  C Y>  =CODE  C Y ) +1 6 

0156 

GOTO  510 

0157 

400 

X7*SCANC4,0EQ.QXQ.0E0.QC0.0. J8) 

0158 

IF  CX7.EQ.0)  GOTO  500 

0160 

IF  CJ8.EQ.9.0R. J8.E0. 15)  GOTO  500 

C 

SET  BITS  12-13 

0162 

CODE  C Y ) =CODE  CY)  + 16+8 

0163 

GOTO  510 

c 

IF  CODE  ENDS  IN  COLUMN  10  OR  16. DO  NOT  ADD  U 

TO  CODECY) 

0164 

500 

IF  CNC0LC10) .EQ.QER.QR.NCOLC 16) .EO.QER)  GOTO 

510 

0166 

CODEC Y)=CODECY)+W 

0167 

510 

WRITE  Cl. 511)  MPAD. CODEC Y ) ,COL 
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| CORE= 

08K  t 

UIC=C20 » 20  J CONDIT . OBJ=CONDI T • FOR/NOSN/L 111 

1 

0168 

511 

FORMAT  < 1 X > 05 t4Xi 05 > 5X • 80 A 1 ) 

0169 

MPAD=MFAD+1 

, 0170 

Y=Y+1 

’[  0171 

RETURN 

■ 0172 

520 

CALL  URT  < 20 » 2 ) 

0173 

RETURN 

- 0174 

530 

CALL  URT <34. 2) 

i 0175 

RETURN 

1 0176 

END 

>’ 
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0001 

SUBROUTINE  LITRL ( V » BEV ) 

0002 

IMPLICIT  INTEGER  ( A- Y ) 

0003 

LOGICAL#  1 WAR  > F VAR » V AR 

0004 

L0GICAL*1  BCOL 

0005 

L0GICAL#1  COL  > NCOL » QAC1  r QBG f OCQ  f ODQ  f QEQ  > QFQ  f OGO  f GHQ  f 010  f QJQ  f QKQ  > 

i olo  f omg , ono  , aoa , or-o  f uoo , qfm  , nso , ora , quo  f o vo , owo , axa  ,aro,  ozo  f 

2Q0Q  F 0 1 Q F 020  f Q3Q  f Q4Q  f 050  f Q6Q  f Q7Q , 080  f 090 » OAR  f QBR f OCR  f ODR f OER  f 
3QFR  f OGR  f QHR 

0006 

DIMENSION  DCOL < 30 ) 

0007 

COMMON  /F'AR/F'Pl  fPP2 

0008 

COMMON  NCOL (30) 

0009 

COMMON  /IMP/COL ( 80 ) f CODE (128) 

0010 

COMMON  /VAX/N.MPADfPRfY 

0011 

COMMON/VAL/VVAR (80f8)fVC0N(80) 

0012 

COMMON  /S JI/FVAR ( 8 ) f VAR  < 100  f 8 > , CON (100) 

0013 

COMMON  /CODES/QAO f OBQ  f QCQ  f QDQ , OEQ f OFO  f QGO  f OHO  f 0 10 , QJQ  f OKQ  f OLO , 
IQMOfONOfQOQfOPQfOOQfOROfOSOfOTQfOUOfOVOfQUOfQXOfQYQfOZOfQOOfOIO 
2020  F 030 , Q4Q  F Q50  f 060  f 070  f 080  f Q90  f 0 AR  f QBR  f OCR  f ODR  f OER  f OFR  f 

3QGR f QHR 

0014 

COMMON  /SUL IT/ 1 D7 

0015 

VW=SCAN ( 3 f QDQ . OEQ ■ OVQ , 0 f 0 f JF ) 

0 

WRITE  (If  890  > VU 

D890 

F0RMAT(1Xf/VW='fI1) 

0016 

IF  (VU.NE.l)  GO  TO  10 

0018 

IF  (JF.NE.3)  GO  TO  10 

0020 

IF  ( NCOL ( 4 ) .NE.  000)  GOTO  420 

0022 

KK=1 

0023 

GOTO  1 

0024 

420 

IF  ( NCOL ( 4 ) .NE.  010)  GOTO  430 

0026 

KK=2 

0027 

GOTO  1 

0028 

430 

IF  ( NCOL ( 4 > .NE.  020)  GOTO  440 

0030 

KK=3 

0031 

GOTO  1 

0032 

440 

IF  ( NCOL ( 4 ) .NE.  030)  GOTO  8 

0034 

KK=4 

0035 

1 

GOTO (5f2f3f4)f  KK 

0036 

8 

CALL  URT ( 24  f 2 ) 

0037 

RETURN 

C 

SET  BIT  14 

0038 

2 

CODE (Y)=C0DE(Y>+4 

0039 

GOTO  5 

C 

SET  BIT  13 

0040 

3 

CODE (Y)=C0DE(Y>+8 

0041 

GOTO  5 

C 

SET  BITS  13+14 

0042 

4 

CODE ( Y ) =CODE ( Y ) +8+4 

0043 

5 

X=SC AN ( 1 f ODR  f 0 f 0 f 0 f 0 f K ) 

D 

WRITE  ( 1 f 891 ) X 

D891 

FORMAT ( ' X='fI1) 

0044 

IF ( X . EQ . 1 > GOTO  7 

0046 

6 

CALL  WRT ( 23  f 2 ) 

0047 

RETURN 

C 

THIS-  CHANGES  FROM  HOLERITH  TO  DECIMAL 

0048 

7 

J=K+1 

0049 

JJ=K+4 

4 

.J 

J 


]; 

] 

! 

i! 

f 

! 


T 
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FEB 

CORE= 

08K. 

UIC=C20»  201 

0050 

DO  11  ID=J. JJ 

0051 

IF  ( NCOL (ID)  .EQ 

. QER) 

- GOTO  13 

0053 

IF  (NCOL (ID) .NE. 

QOQ ) 

GOTO 

501 

0055 

BCOL ( IB ) =0 

0056 

GOTO  11 

0057 

501 

IF  (NCOL(IB) .NE. 

Q1Q) 

GOTO 

502 

0059 

DCOL ( ID ) =1 

0060 

GOTO  11 

0061 

502 

IF  (NCOL(IB) .NE. 

Q2Q) 

GOTO 

503 

0063 

DCOL ( IB ) =2 

0064 

GOTO  11 

0065 

503 

IF  (NCOL( ID) .NE. 

Q3Q ) 

GOTO 

504 

0067 

DCOL (ID) =3 

0068 

GOTO  11 

0069 

504 

IF  (NCOL(IB) .NE. 

Q4Q ) 

GOTO 

505 

0071 

DCOL ( I D ) =4 

0072 

GOTO  11 

0073 

505 

IF  (NCOL(IB) .NE. 

Q5Q ) 

GOTO 

506 

0075 

DCOL ( ID) =5 

0076 

GOTO  11 

0077 

506 

IF  (NCOL(ID) .NE. 

Q6Q  > 

GOTO 

507 

0079 

DCOL (ID) =6 

0080 

GOTO  11 

0081 

507 

IF  ( NCOL (ID)  .NE 

. Q7Q  > 

GOTO 

508 

0083 

DCOL ( I D ) =7 

0084 

GOTO  11 

0085 

508 

IF  ( NCOL (ID)  .NE 

,Q8Q> 

GOTO 

509 

0087 

DCOL (ID) =8 

0088 

GOTO  11 

0089 

509 

IF  (NCOL (ID)  .NE 

. Q9Q ) 

GOTO 

11 

0091 

DCOL (ID) =9 

0092 

11 

CONTINUE 

C 

THIS  MAKES  SURE 

THERE 

IS  A 

con: 

0093 

13 

IF(DrOL( J) .NE. 1 . 

AND. DCOL (J) 

.NE 
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1 .AND . BCOL ( J ) .NE. 


CONSTANT  IN  THE  BED  STATEMENT 

WEi . BCOL  ( J ) . NE  . 3 . AND . BCOL  < J ) . NE  . 4 
. AND . BCOL ( J > . NE . 6 . AND . DCOL ( J ) . NE . 7 . AND . BCOL ( J > 

2. NE. 8. AND. BCOL ( J) . NE . 9 . AND . BCOL ( J) .NE.O)  GOTO  6 
D WRITE  (1.895)  BCOL(J) 

D895  FORMAT (1X.'DC0L(J)='.I1) 

C THIS  FINDS  THE  CINSTANT  IN  THE  DEO  STATEMENT 

0095  AC=DCOL  < J ) 

0096  B=J+1 

0097  IF  ( NCOL  ( B ) . EQ . QER ) GOTO  9 

0099  AC=DCOL< J ) *1 O+BCOL ( B ) 

0100  F=B+ 1 

0101  IF ( NCOL ( F ) . EQ • QER ) GOTO  9 

0103  AC=DCOL ( J ) *1 00  + BCOL ( B ) * 1 0 FDCOL ( F ) 

C THIS  MAKES  SURE  THE  CONSTANT  IS  NOT  TOO  LARGE 

0104  G=F+1 

0105  IF  (NCOL(G) .NE.OEft)  GOTO  6 

0107  IF ( AC. GT . 255 ) GOTO  6 

0109  9 CODE (Y)=CODE(Y>  + AC* 1 6 

D WRITE  ( 1 .61 )AC.CODE (Y). 

D61  FORMAT ( ' AC='.I3,'  CODE ( Y ) = ' . 05 ) 

D WRITE  (1.893) 

D893  FORMAT ( ' ABOUT  TO  CALL  WRT(0.4)  AT  53  IN  LITRL') 

0110  GOTO  400 
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C THE  CONSTANT  CORRESPONDING  TO  THE  VARIABLE  AFTER  THE  B IS  NOW 

C ADDED  TO  THE  CODE.  THE  VARIABLE  WAS  ALREADY  FOUND  IN  THE  MAIN 

C PROGRAH. 

0111  10  IF  ( NCOL  < 1 > . NE . QBQ  > GOTO  15 

0113  CODE  < Y ) =CODE  < Y ) +8+2+ 1 

D WRITE  (1,21)  V 

D21  FORMAT  ('  V=',I3> 

0114  IF  (V.NE.999)  GO  TO  14 

0116  N=N+1 

0117  WRITE ( 1 » 29 ) MPAD  * CODE ( Y ) » < COL  (I), 1=1,80) 

0118  29  FORMAT <1X,05>4X,05»5X»80A1/'  FORMAT  ERROR-VALUE  NOT  DECLARED') 

0119  MPAD=MPAD+ 1 

0120  CODE  ( Y ) =CODE  < Y ) +32753 

0121  Y=Y+1 

0122  RETURN 

0123  14  CODE ( Y ) =CODE  ( Y ) + VCON  < V ) *1 6 

D WRITE  (1,17)  VCON(V) 

D17  FORMAT  ('  VCON< V) = ' , 13 > 

0124  GOTO  400 

C THIS  ASSIGNS  THE  CODE  FOR  THE  CALL  OR  GOTO  STATEMENTS 

0125  15  A5=0 

0126  AB=0 

D WRITE  <1.892) 

D892  FORMAT< IX. 'CHECKING  FOR  CALL  OR  GOTO  IN  LITRL') 

C THIS  CHECKS  TO  SEE  IF  A LIT  TO  IR  CODE  IS  NEEDED 

0127  C=SCAN ( 4 » OCQ . QAO . QLQ .QLQ.0.C1 > 

0128  IF  (C.NE.l)  GO  TO  20 

0130  D7=6 

0131  GOTO  25 

0)32  20  D7=14 

0133  25  DO  27  0=1,8 

0134  Dl=D+4 

0135  IF  (NCOLCDl ) .EQ.QER)  GO  TO  30 

0137  27  FVAR(D)=NCOL (D1  ) 

0138  GO  TO  33 

0139  30  D2=D1 -4 

0140  DO  32  DD=D2 » 8 

0141  32  FVAR ( DD ) =GHR 

0142  33  CONTINUE 

D WRITE (1,34)  FVAR 

0143  34  FORMAT < ' LABEL  IS  ' , 8A1 ) 

0144  DO  40  AG=1,PP2 

0145  DO  35  AH=1 , 8 

0146  IF  < FVAR < AH ) . NE . VAR  < AG » AH  > ) GO  TO  40 

0148  35  CONTINUE 

0149  D4=AG 

0150  GO  TO  45 

0151  40  CONTINUE 

0152  N=N+ 1 

0153  WR I TE  < 1 , 23 ) MPAD , CODE  < Y ) . < COL  < I > . I = 1 , 80  > 

0154  23  FORMAT <1X,05.4X,05»5X»80A1/'  FORMAT  ERROR-LABEL  NOT  DECLARED') 

0155  MPAD=MPAD+1 

0156  Y=Y+1 

0157  RETURN 

0158  45  D5=MOD<CON(D4) ,256) 

0159  D7=D7+D5*16 
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0160 

D6=C0N(D4)-D5 

0161 

CODE <Y)=D6/1 6+3 

0162 

WRITE C 1 > 46 ) MPAD » CODEC Y) 

0163 

46 

FORMAT C 1 X . 05  . 4X .05) 

0164 

Y=Y+1 

0165 

IF  < Y .GT.  128)  ID7=D7 

0167 

MPAD=MPAD+1 

0168 

CODEC Y)=D7 

016? 

GO  TO  400 

C 

THIS  ASSIGNS  THE  LIT  TO  IR  CODE 

0170 

50 

■CODEC Y)=CODEC Y) +2+1 

C 

THIS  FINDS  THE  PROPER  LABEL  FOR  THE  STATEMENT 

0171 

DO  60  H= 1 r 8 

0172 

Hl«=H+4 

0173 

IF  CNC0LCH1 ) .EQ.QER)  GO  TO  63  ■ 

0175 

60 

FVARCH)=NCQLCH1 ) 

0176 

63 

lN=Hl-4 

0177 

DO  64  I = IN » 8 

0178 

64 

FVAR  C I ) =QHR 

0179 

DO  70  AB=  1 » PF‘2 

0180 

DO  65  AC=1 » 8 

0181 

IF  CFVARCAC) .NE.VARCAB.AC) > GO  TO  70 

0183 

65 

CONTINUE 

0184 

AZ=AB 

0185 

GOTO  100 

0186 

70 

CONTINUE 

0187 

AB=0 

0188 

WR I TE C 1 . 23 ) MPAD » CODE C Y ) » COL 

018? 

MPAD=MPAD+ 1 

0190 

Y=Y+1 

0191 

N=N+ 1 

0192 

GOTO  150 

C 

THE  LABLE  HAS  BEEN  FOUND  AND  THIS  ADDS  THE  CORRESPONDING 

C 

VALUE. 

0193 

100 

AB=AZ 

0194 

A5=  C CON  C AB ) -16 ) /256 

0195 

CODEC Y)=CODEC Y5+A5* 16 

0196 

WRITE  C1.401)  MPAD. CODEC Y> .COL 

0197 

MPAD=MPAD+ 1 

0198 

Y=Y+1 

0199 

CODE  C Y ) = -l 6 

c 

IT  IS  PAST  THE  LIT  TO  IR  AND  THE  PROGRAM  IS  CHECKING 

TO  SEE 

c 

THE  PROGRAM  WILL  NOW  DO  TWICrWHAT  THE  LIT  TO  IR  PART 

DID. 

c 

ONCE  FOR  THE  CALL  AND  ONCE  FOR  THE  GOTO 

0200 

150 

L1=SCAN  C4.QCGfGAG.0LC)>  QLQ » 0 > D3 ) 

0201 

IF  CL1.NE.1)  GO  TO  270 

0203 

CODE  C Y ) =CODE  C Y > + 4+2 

0204 

170 

IF  CAB  .NE.  0)  GOTO  200 

0206 

MPAD=MPAD+1 

0207 

RETURN 

0208 

200 

XY=MOD  C CON  C AB ) .256) 

0209 

CODE  CY)=C0DECY)+XY*16 

0210 

GOTO  400 

0211 

270 

CODE  CY ) =CODE  C Y ) + 1 4 

0212 

GOTO  170 

0213 

400 

WRITE (1.401)  MPAD.CODECY) .COL 
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0214  401  FORMAT: lXf05.4X.05»5X.80Al ) 

0215  MRAD=hPAD+l 

0216  Y*=Yil 

0217  RETURN 

0218  END 

> 
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NCOL(2 1 


NCOL(2) 


CODE(Y)  = 
CODE(  Y)+8 


CODE(Y) 
CODE*  Yl+32- 
16+8+4 


NCOL(3» 


CODE*  Y) 
CODE*  Y » 
+ 8+4 


NCOL(8) 


WHITE  MPAD, 
CODEiYt,  COL 
and  "Format 
Error  - Missing 
Digit  after  A.  " 


RETURN 


CODE*  Y > 
CODE*  Y ' 
+32+18+4 


NCOL<4> 
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LOGIC  (cont.) 


1 

T is  equal  to 
the  position  of 
the  "="  sign 
in  NCOL 

Figure  1-8.  (Cont.) 
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0001 

0002 

0003 


0004 

0005 

0006 
0007 


0008 

0009 

0010 
0012 

0013 

0014 

0015 

0017 

0018 

0019 

0020 
0022 

0023 

0024 

0025 

0027 

0028 
0029 
0031 

0033 

0035 

0036 

0038 

0039 

0041 

0042 

0043 
0045 

0047 

0048 

0049 

0050 

0051 

0053 

0054 

0055 
0057 

0056 


SUBROUTINE  LOGIC 
IMPLICIT  INTEGER  <A-Y> 

LOGICAL*l  COL  f NCOL  > GAQ » GBQ f QCQ » QDD f GEG  f QFQ f QGQ f QUO  . QIQ f G JQ  > QKQ » 
10LG f OMO » QNQ  t GOO  ? QPQ » QQG  > QRQ  f GSQ » QTQ • QUO  f OVQ  ? QUO  f QXQ  f QYO  f QZG  f 
2G0GfG10fG2G,G3GfG4Q,G5GfQ6GfQ7D,Q8GfG9GfQARfGBR,QCR.GDR.GER', 

30FR  f GGR f GHR 
COMMON  NCOL (30) 

COMMON  /IMP/COL < 80 ) f CODE ( 1 28 ) 

COMMON  /VAX/Nf  MPADfFR  f Y 

COMMON  /COBES/GAG  f GBQ  f GCG  f QBG  f GEG  f QFQ , GGO  f GHG  f QIQ , Q JG , QKQ  f GLG  f 
IGMOfGNGfGOGfGPGfQGQfQRGfGSQfGTQfGUQfGVGfGUQfQXQfQYGfQZQfGOQfQIQf 
2G2G f G3G  f Q4G  f 050 , Q6Q  f G7G  f Q8Q  f G9Q f QAR  f QBR  f OCR  f GBR  f QER  f GFR  f QGR  f GHR 
DIMENSION  U < 30 > 

C SET  BIT  16 
CODE ( Y ) =1 

IF  < NCOL < 4 ) . NE . GOQ)  GOTO  2 

W=1 

KK=1 


2 

GOTO  10 

IF  ( NCOL ( 4 ) 

.NE. 

GIG) 

GOTO 

3 

3 

U=2 

KK=2 

GOTO  10 

IF  ( NCOL ( 4 ) 

.NE. 

G2Q) 

GOTO 

4 

4 

W=3 

KK=3 

GOTO  10 

IF  ( NCOL ( 4 ) 

.NE. 

G3G; 

GOTO 

10 

10 

W=4 

KK=4 

IF  (NCOL(l) 

.NE. 

OBO) 

GOTO 

100 

IF  (NCOL (2) 

.EG. 

GBR) 

GOTO 

500 

C GO  CHECK  AFTER  THE  EQUAL  SIGN 
IF  (NCOL ( 2 > .NE.  GSG ) GOTO  60 


C SET  BITS  1 1 f 12 

CODE  < Y ) =COBE (Y)+32+16 
IF  (NC0L(3>  .EG.  GDR > GOTO  500 
GOTO  696 

60  IF  ( NCOL < 2 ) .EG.  GEQ  .AND.  NC0L<3>  .EG.  QXQ)  GOTO  65 
CALL  WRT ( 18  f 2 > 

RETURN 

65  IF  (W.LT.1.0R.W.GT.4)  GOTO  67 

IF  ( NCOL ( 4 ) . EG . GAG . OR . NCOL ( 4 > . EQ . GBQ . OR . NCOL ( 4 ) . EG . GCG ) GOTO  67 
GOTO  <70f80f90f95)  U 
67  CALL  WRT ( 26  f 2 ) 

RETURN 

C SET  BIT  11 

70  CODE (Y)=C0DE(Y)+32 

IF  (NCOL <6) .EG. GDR)  GOTO  500 
GOTO  696 

C SET  BITS  1 1 f 1 4 

80  CODE ( Y ) =CODE (Y)+32+4 

IF  ( NCOL (7) .EG. GDR)  GOTO  500 
GOTO  696 
CSET  BITS  1 1 f 1 3 
90  CODE ( Y > =CGDE ( Y ) +32  + 8 
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0090 
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0101 
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301 
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IF  (NC0LC7) .EQ.QDR)  GOTO  500 
GOTO  696 

SET  BITS  11,13.14 

CODE  < Y ) =COBE  < Y ) +32+84  4 

IF  <NC0L(7) . EQ.GDR)  GOTO  500 

GOTO  496 

CHECK  'OUT' 

IF  (NCOL(l)  .NE.  QOQ)  GOTO  200 
IF  (KK.LT.1.0R.KK.GT.4)  GOTO  105 

IF(NC0L(4> .EQ.QAQ.OR.NCOL (4) .EQ.QBQ.OR.NCOL (4) .EQ.QCQ)  GOTO  105 
GOTO  (110,120,130.140)  KK 
CALL  URT (31,2) 

RETURN 

SET  BIT  12 

CODE ( Y ) =CODE ( Y ) +16 

IF  (NC0LC5) .EQ.QDR)  GOTO  500 

GOTO  696 

SET  BITS  12,14 

CODEC Y)=CODE(Y) +16+4 

IF  (NC0L<5) .EQ.QDR)  GOTO  500 

GOTO  694 

SET  BITS  12,13 

CODE  < Y ) =CODE (Y>  + 16+8 

IF  ( NCOL < 5 ) , EQ • QDR)  GOTO  500 

GOTO  694 

SET  BITS  12-14  . 

CODEC Y)=CODE(Y) +16+8+4 

IF  ( NCOL ( 10 ) .EQ.  QDR)  GOTO  500 

GOTO  696 

IF  CNCOL(l).EQ.OAQ)  GOTO  300 
CALL  URT (32. 2) 

RETURN 

IF  ( NCOL ( 2 ) • NE • Q1Q ) GOTO  11 

US-1 

GOTO  20 

IF  (NCOL (2) .NE.Q2Q)  GOTO  12 

US-2 

GOTO  20 

IF  (NCOL (2)  .NE.  Q3Q)  GOTO  20 
US-3 

IF  ( US . LT . 1 . OR . US • GT . 3 ) GOTO  305 

IF  (NCOL (2) . EQ . QAQ . OR .NC0L(2).EQ. QBQ . OR • NCOL ( 2 ) «EQ . QCQ ) GOTO  696 
GOTO  (310,320,330)  US 
CALL  URT (33, 2) 

RETURN 

IF  ( NCOL ( 3 ) . EQ . QSQ ) GOTO  315 
SET  BIT  14 
CODEC Y )=CODE ( Y ) +4 
IF  (NC0L(3>. EQ.QDR)  GOTO  500 
GOTO  494 

SET  BITS  11,12.14 
CODE ( Y ) -CODE (Yl+32+16+4 
IF  (NCOL (4) .EQ.QDR)  GOTO  500 
GOTO  496 

IF  ( NCOL ( 3 > • EQ . QSQ ) GOTO  325 
SET  BIT  13 
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0125  CODE ( Y ) =C0DE ( Y ) +8 

0126  IF  < NCOL  ( 3 ) . EG . ODR  ) GOTO  500 

0128  GOTO  696 

C SET  BITS  11-13 

0129  325  CODE  (Y)=C0DE(Y)+32+16+8 

0130  IF  (NC0L(4> .EO.ODR)  GOTO  500 

0132  GOTO  696 

0133  330  IF  (NC0L(3) .EQ.GAQ)  GOTO  335 

0135  CODE  < Y ) =CODE ( Y > J 8 14 

0136  IF  ( NCOL  ( 3 ) . EQ . GDR ) GOTO  500 

0138  GOTO  696 

C SET  BITS  11-14 

0139  335  CODE (Y)=C0DE(Y)+32+16+8t4 

0140  IF  ( NCOL < 8 ) . EQ . GDR)  GOTO  500 

0142  GOTO  696 

C SEARCH  FOR  *=*-SAVE  POSITION 

0143  500  X=SCAN<1 . QDR . 0 . 0 . 0 . 0 . M > 

0144  MB=M-1 

0145  T=M+1 

0146  S=T+2 

C U(T)  SET  AT  11  TO  GET  OUT  OF  TEST  LATER 

0147  U(T)=11 

0148  DO  40  L=TfS 

0149  IF  (NCOL(L).NE.  000)  GOTO  21 

0151  U<  L > =0 

0152  GOTO  40 

0153  21  IF  < NCOL (L  > . NE . 010)  GOTO  22 

0155  U < L ) = 1 

0156  GOTO  40 

0157  22  IF  < NCOL < L ) . NE . 020)  GOTO  23 

0159  U(L)=2 

0160  GOTO  40 

0161  23  IF  < NCOL ( L ) . NE . 030)  GOTO  24 

0163  U(L>=3 

0164  GOTO  40 

0165  24  IF  (NCOL(L)  .NE.  040)  GOTO  25 

0167  U < L ) =4 

0168  GOTO  40 

0169  25  IF  < NCOL ( L ) .NE.  050)  GOTO  26 

0171  U(L>=5 

0172  GOTO  40 

■0173  26  IF  ( NCOL ( L > .NE.  060)  GOTO  27 

0175  U(L ) =6 

0176  GOTO  40 

0177  27  IF  (NCOL(L)  .NE.  070)  GOTO  28 

0179  U ( L ) =7 

0180  GOTO  40 

0181  28  IF  (NCOL (L ) .NE.  080)  GOTO  29 

0183  U < L ) =8  * 

0184  GOTO  40 

0185  29  IF  (NCOL(L)  .NE.  090)  GOTO  40 

0187  U(L>=9 

0188  40  CONTINUE 

D WRITE  (1.41)  U ( T ) . NCOL 

D41  FORMAT  ('  U(T)='.I2.'  NC0L='»30A1> 

0189  IF  (U(T) .LT.O.OR.U(T) .GT.9)  GOTO  509 
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IF  (NCOL(T) .EQ.Qia.AND.NCOL(T+l ) .EQ.QER)  GOTO  650 
IF  ( NCOL ( T > . EO . GOO . AND . < NCOL  < T + 1 ) . EQ . OER . OR . NCOL (T  + l ) . EQ.QEQ) ) 
1G0T0  600 

IF  (NCOL(MB) .NE.QBQ)  GOTO  696 
AD=U(T) 

Q=T+1 

IF  CNCOLCQ) .EQ.QER)  GOTO  502 
AD=UCT)*10+UCQ> 

IF  CNCOLCS) .EQ.QER)  GOTO  502 
AD=UCT)*100+UCQ>*10+UCS> 

SS=S+ 1 

IF  CNCOLCSS) .NE.QER)  GOTO  504 

IF  (AD.GT.255)  GOTO  504 

CODEC Y)=CODECY) +8+2 

CODEC Y)=C0DECY)+AD*16 

URITE  Cl. 43)  MPAD. CODEC Y) .COL 

MPAD=MPAD+1 

Y=Y+1 

RETURN 

CALL  WRTC40.2) 

RETURN 

IF  C NCOL  C T ) . NE . QAQ ) GOTO  550 
IF  CNCOLCT+1)  .NE.  Q1Q)  GOTO  551 
UD=1 

GOTO  555 

IF  CNCOLCT+1)  .NE.  Q2Q)  GOTO  552 
UD=2 

GOTO  555 

IF  CNCOLCT+1)  .NE.  Q3Q)  GOTO  555 
UD=3 

IF  CNCOLCT+1 > .EQ.QMQ)  GOTO  670 
IF  CUD.LT.1.0R.CJD.GT.3)  GOTO  508 
GOTO  C510.520.530)  UD 
CALL  URTC33.2) 

RETURN 
SET  BIT  6 

CODEC Y)=CODECY) +1024 
GOfO  1000 
SET  BIT  5 

CODE  C Y ) =CODE  CY)+2048 
GOTO  1000 
SET  BITS  5-6 

CODE  C Y ) “CODEC  Y ) + 1024  + 2048 
GOTO  1000 

IF  CNCOLCT) .NE.QOQ)  GOTO  600 

IF  C NCOL  C 2 ) .EQ.QSQ.0R.MC0LC2) . EQ . Q1Q . OR . NCOL C 2 ) .EQ.Q2Q) 

1G0T0  570 

IF  CNC0LC2) .EQ.QMQ. OR. NC0LC2) .EQ.QUQ)  GOTO  560 

SET  BITS  7.9 

CODEC Y)=CODECY) +512+ 128 

GOTO  695 

SET  BITS  7.10 

CODEC Y)=CODECY) +512+64 

GOTO  695 

SET  BITS  6.7.9.10 

CODEC Y)=CODE(Y >+1024+512+128+64 
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GOTO  695 

IF  (NCOL(T).NE.  000)  GOTO  650 
X=SCAN(3>OEQfOOQ.QOQ.O.O.P) 

IF  <X.NE. 1 ) GOTO  610 
SET  BIT  8 

CODE  < Y ) =CODE < Y ) +256 

IF  (NC0L(P+1 > .E0.QB0.0R.NC0L(P+1 > .EO.OAO)  GOTO  695 
GOTO  696 

IF  (NC0L(T+1).EQ.0ER)  GOTO  620 

GOTO  696 

SET  BITS  9-10 

CODE< Y>=CODE< Y) +128+64+512+1 28 
GOTO  695 

IF  < NCOL ( T ) . NE .010. OR . NCOL ( T+l ) • NE . OER ) GOTO  670 
SET  BIT  9 

CODE < Y ) =CODE ( Y ) + 1 28 

GOTO  695 

DO  680  J=Tf26 

C=J 

K=J+4 

IF ( NCOL ( J ) . EO . QAQ . AND . NCOL ( J+ 1 ) . EO . QhQ . AND . NCOL ( J+2 ) .EQ.QPQ 
1 . AND • NCOL ( J+3 ) . EO . OCO . AND . NCOL < J+4 > . EO . QRQ ) GOTO  690 
CONTINUE 
GOTO  750 

XsSCANOfONGfOOOfQROfOfOfP) 

XN=SCAN ( 3 , ONQ , 000 . OTO , 0 , 0 f P ) 

IF  <X.NE.i.AND.XN.NE.l)  GOTO  700 

IF  (NC0L(N-5) .CQ.ORO.OR.NCOLCK-S) .EO.OTO)  GOTO  697 

GOTO  696 

SET  BITS  7,9 

CODE  ( Y ) =CODE ( Y ) +51 2+ 1 28 

GOTO  695 

X=SC AN ( 3 , OAR  fQIOfOERfOfOfP) 

IF  (X.NE.l)  GOTO  710 
IF  (NC0L(K+1 ) .NE.  OAR)  GOTO  696 
SET  BIT  9 

CODE  < Y ) =CODE ( Y ) + 1 28 
GOTO  695 

CHECK  AFTER  ,AMPCR’ 

IF  ( NCOL (K+ 1 ) .NE.  OER)  GOTO  696 

SET  BITS  9-10 

CODE  < Y ) =CODE ( Y ) + 1 28  + 64 

GOTO  695 

IF  (NCOL(T).EQ.  QBQ ) GOTO  760 
CALL  URT (18,2) 

RETURN 


IF 

( NCOL (T  + l ) 

.NE. 

QFQ  > 

GOTO 

800 

IF 

< NCOL  < T+2) 

.EO. 

OAR) 

GOTO 

780 

IF 

< NCOL ( T+2  > 

.EO. 

OER) 

GOTO 

770 

GOTO  696 
SET  BITS  8-10 

CODE (Y)=CODE< Y> +256+128+64 

GOTO  695 

SET  BITS  8-9 

CODE <Y)=CODE< Y) +256+128 

IF  CNC0L(T+3> .EQ.Q1Q)  GOTO  695 
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0317 

0316 

0320 

0322 

0323 

0324 

0325 

0326 

0327 

0328 

0329 

0330 

0331 

0332 


GOTO  696 

800  IF  < NCOL (T-El).EQ. OAR . AND . NCOL ( T+2) .EQ.Q1Q. AND • NCOL < T+3 > « EO . 
1QER>  GOTO  695 

IF  <NC0L(T+1> .NE.  QER)  GOTO  696 
C SET  BIT  10 

CODEC Y)=COPE(Y> +64 

695  URITE  (1.43)  MFAD . CODE < Y ). COL 
43  FORMAT  ( IX » 05 . 4X » 05 » 5X . 80A1 ) 

MPAIi=MPAB+l 

Y=Y+1 

RETURN 

696  CALL  WRT  < 34 1 2 ) 

RETURN 

1000  CALL  LOGICA(T) 

RETURN 

END 
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0001 

0002 

0003 


0004 

0005 

0006 
0007 


SUBROUTINE  LOGICA(T) 

IMPLICIT  INTEGER  (A-Y) 

L0GICAL41  NC0L fCOLfOAQfQBQf QCO f ODD  f QEQ f QFQ , QGQ » OHQ f GIG  f Q JG  t QKQ t 
1QL0 f GMQ . QNQ  r QOG  f 0F  0 f GQQ  f QRQ  f QSQ  f OTQ  f QUO f OVQ  f QUO  f OXQ  f OYQ  f QZQ  f 
200Q f 0 1 0 f 020 f 03Q f 040 f 05Q f Q60 f 07Q f Q8Q f Q9Q f QAR f QBR f OCR f QBR f QER f 
3QFRfQGRfQHR 
COMMON  NCOL  < 30 ) 

COMMON  /IMP/COL ( 80 ) ? CODE < 128 ) 

COMMON  /VAX/NfMPADfFRfY 

COMMON  /COriES/QAOFQBOFQCOFOriOFOEOFQFQFQGOFOHOFOIOFQja,aKOFQLO. 
lOMQFONQFQOOFOPQFaaQFOROFOSOFOTOFQUOFOVOFOUQFOXQFQYOFQZQFQOQFQlOF 
2020  f Q3Q  f 040  f 050 , 060  f Q7Q  f 080  f 090  f OAR  f QBR  f OCR  f OUR  f OER  f QFR . OGR  f QHR 


C IF  NCOL  < N ) =A 

0008  X=SCAN<1fOFQfOfOfOfOfQ) 

D WRITE  (IfDTfX 


D1  FORMAT  ('  IN  LOGICA : T= ' f 12 f ' X='fI1) 

0009  IF(X.NE.  1)  GO  TO  1050 

0011  IF  (NCOL <0-1 ) .NE.OBQ. AND. NCOL (0-1) .NE.01Q. AND. NCOL (Q-l) .NE.Q2Q 


0013 

0015 

0016 

0018 

0019 

0021 

0023 

0024 

0025 

0027 

0028 
0030 

0032 

0033 

0035 

0036 

0037 

0038 

0039 

0041 

0042 

0043 

0044 
0046 

0048 

0049 

0051 

0052 

0053 
0055 


1 f AND f NCOL < 0-1 > . NE . Q3G ) GO  TO  696 
IF  ( NCOL ( 0+1 ) . NE • OAR . AND . NCOL  < Q H ) • NE « QER  ) GO  TO  696 
X=SCAN ( 3 f 0 AO  f QNQ  f QUO  f 0 f 0 f P ) 

IF(X.NE.l)  GO  TO  1010 
C SET  BITS  7-10 

CODE ( Y > =CODE  < Y ) +5 1 2+256+ 1 28+64 
IF(NC0L(F'+1 ) .NE.OBQ)  GO  TO  696 
IF ( NCOL (0+1 ) .NE . OER)  GO  TO  696 
GO  TO  695 

1010  X=SCAN(2fOOQfQROfOfO.OfP) 

IF(X.NE.l)  GO  TO  1020 
C SET  BITS  7-9 

CODE <Y)=CODE(Y) +512+256+128 
IF ( NCOL  < P+1 > . NE . OBO  > GO  TO  696 
IF  < NCOL ( 0+1 ) , NE . OER ) GO  TO  696 
GO  TO  695 

1020  IF  ( NCOL ( 0+1 > . NE . QER ) GO  TO  696 
C SET  BITS  7-9 

CODE (Y)=CODE(Y) +512+128 
GO  TO  695 
1050  DO  5 I=T  f 26 
IX=I 

IF  (NCOL(I) . EQ.OAQ. AND. NCOL (1+1) . EQ . OMQ . AND . NCOL < 1+2) .EQ.OPO 
1 . AND .NCOL (1+3) .EQ. GCQ . AND . NCOL < 1+4 ) . EQ . ORO ) GO  TO  1060 
5 CONTINUE 

GO  TO  2000 

1 060  X=SCAN < 3 f QNQ  f 000  f ORQ fOfOfP) 

IF(X.NE.l)  GO  TO  1070 
IF  < NCOL  < IX+5 ) . NE • QER ) GO  TO  696 
C SET  BITS  7f9 

CODE ( Y ) =CODE  < Y ) +542+1 28 

IF  < NCOL (IX-l).EO. QRQ ) GO  TO  695 

GO  TO  696 

1070  X=SCAN(3fONQfQAOfQNOfOfOfP) 

IF  (X.NE.l)  GO  TO  1080 

IF  (NCOL (IX+5). NE . OER > GO  TO  696 


C SET  BITS  7f 9 f 1 0 

CODE <Y)=CODE< Y> +512+128+64 
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IF  (NCOL( IX-1 ) . EQ.QNQ)  GO  TO  695 
GO  TO  696 
I = IX 

IF  < NCOL  < 1+5 ) . NE . QAR . OR . NCOL  < 1+6  > 
1G0  TO  1095 
SET  BIT  9 

CODE ( Y ) =CODE ( Y > + 1 28 
GO  TO  695 

IF  < NCOL < I +5) .NE.QER)  GO  TO  696 

SET  BITS  9-10 

CODE ( Y ) =CODE ( Y > + 1 28+64 

GO  TO  695 

X=SCAN  ( 3 , QEQ  > GQG  * QVQ  , 0 » 0 » F' ) 

IF  (X.NE.l)  GOTO  2010 
SET  BIT  8 

CODE < Y ) =CODE <Y> +256 
IF  ( NCOL  (P+1 > . NE.QBQ. AND. NCOL (P+ 1 ) 
IF  (NCOL (P-3) .NE.OOQ. AND. NCOL (P-3) 
1 • AND. NCOL ( P-3 ) . NE • G3Q > GO  TO  696 
IF  ( NCOL ( F+2 > .NE.QER. AND. NCOL (P+2 > 
IF  ( NCOL ( P+6 ) . NE . QHR . AND . NCOL ( P+6 ) 
GO  TO  695 

X«SCAN ( 3 , QXQ . QOQ , QRQ , 0 . 0 . P > 

IF  (X.NE.l)  GO  TO  2020 
SET  BITS  8,10 
CODE(Y)=CODE(Y >+256+64 
IF  (NCOL (P+1 ) .NE.QBQ. AND. NC0L(P+1 > 
IF  ( NCOL ( F'-3 ) . NE . Q 1 Q . AND . NC0L(P-3 
1G0  TO  696 

IF  (NCOL (P+2) .NE.QER. AND. NCOL (P+2) 
IF  ( NCOL ( P+6 ) . NE • QHR . AND . NCOL ( P+6 ) 
GO  TO  695 

X=SCAN ( 3 r QNQ , QOQ , QRQ . 0 . 0 , P ) 

IF  (X.NE.l)  GO  TO  2030 
SET  BIT  7 

CODE ( Y ) =CODE ( Y > +512 
IF  (NCOL (P+1 ) .NE.QBQ. AND. NCOL (P+1 ) 
IF  (NCOL (P-3) .NE.Q1 Q. AND. NCOL (P-3 > 
1G0  TO  696 

IF  (NC0L(P+2> .NE.QER. AND. NC0L(P+2) 
IF  (NCOL (P+6) .NE. QHR. AND. NCOL (P+6 > 
GO  TO  695 

X=SCAN ( 3 , QNQ . QAQ . QNQ . 0 . 0 , P ) 

IF  (X.NE.l)  GOTO  2040 
SET  BITS  7,10 
CODE ( Y ) -CODE ( Y ) +5 1 2+64 
IF  (NCOL (P+1 ) .NE.QBQ. AND. NCOL (P+1 ) 
IF  ( NCOL (P-3 ).NE.Q1Q> AND. NCOL (P-3) 
1G0T0  696 

IF  (NCOL (P+2) .NE.QER. AND. NCOL (P+2) 
IF  ( NCOL ( P+6 ) • NE • QHR . AND . NCOL (P+6  > 
GOTO  695 

X=SCAN ( 2 » QOQ , QRQ  »0»0»0»P) 

IF  (X.NE.l)  GO  TO  2050 

SET  BITS  7-8 

CODE ( Y > =CODE ( Y > +5 1 2+256 


.NE.Q1Q. OR. NCOL (1+7) .NE.QER) 


NE.QAQ)  GO  TO  696 
, NE.  Q1 Q.  AND.  NCOL  (F'-3)  .NE.Q2Q 

. NE.QMQ)  GO  TO  696 
NE.QER)  GO  TO  696 


.NE.QAQ)  GO  TO  696 
) .NE.Q2Q. AND . NCOu ( F -3 > . NE . 03«  > 

.NE.QMQ)  GO  TO  696 
.NE.QER)  GO  TO  696 


.NE.QAQ)  GO  TO  696 
. NE.Q2Q. AND. NCOL (P-3 ) .NE.Q3Q) 

.NE.QMQ)  GO  TO  696 
.NE.QER)  GO  TO  696 


.NE.QAQ)  GOTO  696 
. NE.Q2Q. AND. NCOL ( P-3 ) .NE.Q3Q) 

.NE.QMQ)  GOTO  696 
.NE.QER)  GOTO  696 
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0126 

0128 

0130 

0132 

0134 

0135 

0136 

0138 

0139 
0141 

0143 

0145 

0147 

0148 

0149 

0151 

0152 
0154 

0156 

0158 

0160 

0161 

0162 

0164 

0165 
0167 

0169 

0171 

0173 

0174 


0176 

0177 

0178 

0180 

0181 

0182 

0184 


0186 

0187 

0188 

0190 

0191 

0192 


IF  ( NC0L (P+1 ) • NE ■ QBQ . AND . NCOL ( P+ 1 > . NE . QAQ ) GO  TO  696 
IF  (NCOL (P-2) .NE. 01 0. AND. NCOL < P-2) .NE.Q2Q. AND. NCOL (P-2). NE. 030) 
1 GO  TO  696 

IF  < NCOL  ( P+2 ) • NE . QER . AND . NCOL  ( P+2 ) . NE . QMQ ) GO  TO  696 
IF  < NCOL  < P+6 ) . NE . OHR . AND . NCOL  ( P+6 ) . NE . QER ) GO  TO  696 
GO  TO  695 

2050  X=SCAN  ( 3 . QAQ  > QNQ  . OBQ , 0 1 0 » P ) 

IF  (X.NE.l)  GO  TO  2060 
C SET  BITS  7.8.10 

CODE (Y)=CODE(Y) +512+256+64 

IF  ( NCOL ( P+ 1 ) . NE . QBQ . AND . NCOL (P+1 ) • NE . QAQ ) GO  TO  696 
IF  < NCOL  CP-3) . NE . Q1 Q . AND . NCOL ( P-3 ) • NE . Q2Q . AND • NCOL ( P-3 ) . NE • 030 ) 
1G0  TO  696 

IF  (NCOLCP+2) .NE. QER. AND. NCOL ( P+2 > .NE.QMQ)  GO  TO  696 
IF  < NCOL < P+6 ) . NE . OHR . AND • NCOL ( P46 ) . NE . OER ) GO  TO  696 
GO  TO  695 

2060  X=SCAN(3»QRQ.QIQ»  QMQ  . 0 » 0 * P ) 

IF  (X.NE.l)  GO  TO  2070 
C SET  BITS  7-9 

CODE  < Y ) =CODE ( Y > +5 12+256+128 

IF  ( NCOL (P+1 ) . NE . QBQ . AND . NCOL (P+1 ) • NE . OAQ ) GO  TO  696 
IF  (NCOL (P-3) . NE. Q1Q. AND. NCOL ( P-3 ) .NE.Q2Q. AND. NCOL (P-3 > .NE.Q3Q) 
1G0  TO  696 

IF  ( NCOL ( P+2 ) . NE . QER . AND . NCOL (F+2) .NE. QMQ ) GO  TO  696 
IF  (NCOL (P+6) .NE. OHR. AND. NCOL (F+6) .NE. QER)  GO  TO  696 
GO  TO  695 

2070  X=SCAN ( 3 - QNQ .010. QMQ . 0 . 0 . P ) 

IF  (X.NE.l)  GO  TO  2080 
C SET  BITS  7-10 

CODE(Y)=CODE(Y) +512+256+128+64 

IF  ( NCOL  (P+  1 ) , NE  . QER  . AND . NCOL  ( P+ 1 ) . NE  . OAQ  ) GO  TO  696 
IF  (NCOL (P-3) .NE. 010. AND. NCOL (P-3) .NE. 020. AND. NCOL (P-3) .NE. 030) 
1G0  TO  696 

IF  (NCOL (P+2) .NE. OER. AND. NCOL (P+ 2) .NE.QMQ)  GO  TO  696 
IF  (NCOL (P+6) .NE.QHR. AND. NCOL (P+6) .NE. QER)  GO  TO  696 
GO  TO  695 

2080  IF  ( NCOL  ( T+2 ) . NE . QAR . OR . NCOL  ( T+3 ) . NE  . Q1Q . OR . NCOL  ( T+4  ) . NE . QER ) 
1G0  TO  2100 
C SET  BIT  9 

CODE ( Y ) =CODE ( Y ) + 1 28 
GO  TO  695 

2100  IF  (NC0L(T+2) .NE. QER. AND. NC0L(T+2) .NE.QHR)  GO  TO  2110 
C SET  BITS  9-10 

CODE (Y)=CODE(Y> +128+64 
GO  TO  695 

2110  IF  ( NCOL ( T+2 ) . NE . QBR . OR . NCOL ( T+3 ) . NE . QBQ ) GO  TO  2160 

IF  (NCOL (T+4) . NE . QBR . OR .NC0L(T+5) . NE . Q1Q . OR . NCOL ( T+6 ) .NE.QER) 
1G0  TO  2140 
C SET  BITS  8-10 

CODE (Y)=CODE(Y) +256+128+64 
GO  TO  695 

2140  IF  (NC0L(T+4) .NE.QER)  GO  TO  696 
C SET  BITS  8-9 

CODE(Y)=CODE(Y >+256+128 
GO  TO  695 

2160  IF  ( NCOL  ( T+2 ) . NE . QAR . OR . NCOL  ( T+3 ) . NE  • QBQ ) GO  TO  696 
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0194  IF  (NCOL (T+4 > .EQ. OAR .AND. NCOL ( T+5) . E0.Q1Q. AND.NCOL (T+6 ) . EQ.QER). 

1G0  TO  695 

0196  IF  < NCOL  < T+4 ) . EQ . QER ) GO  TO  2180 

0198  696  CONTINUE 

0199  CALL  URT<34,2> 

0200  RETURN 

C SET  BIT  10 

0201  2180  CODE  < Y >=CODE  < Y ) +64 

0202  695  CONTINUE 

0203  URITE  (1» 699)  MPAD f CODE ( Y ) , COL 

0204  699  FORMAT  < IX r 05 » 4X , 05 f 5X » 80A1 ) 

0205  MPAD=MPAD+1 

0206  Y=Y+1 

0207  RETURN 

0208  END 

> 
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1.2  M1710  Common  Area 


Communication  between  a host  PDP-11  processor  and  an  ESM  loop  CIE 
microprocessor  is  accomplished  through  the  use  of  an  M1710  General 
Purpose  Interface  board.  A packet  (256  bytes)  can  be  transferred 
between  the  two  machines  in  the  form  of  16-bit  words  at  a maximum 
rate  of  560  Kilobaud.  A more  detailed  description  of  loop-host 
interfacing  can  be  found  in  the  ESM  Hardware  Maintenance  Manual. 


PDP-11  Software 

interfacing  is  accomplished 

by  six  registers  which 

are  provided  by  the  M1710  board.  The  parameters  of  these  six 
registers  are  tabulated  below: 

Register  Address 

Array  Element 

Functional  Description 

761000 

DEVST(l) 

Read  Data  Word 

761002 

DEVST (2) 

Write  Data  Word 

761004 

DEVST (3) 

Read  Input  Buffer  Status 

761006 

DEVST (4) 

Read  Output  Buffer  Status 

761010 

DEVST (5) 

Clear  Input  Buffer  Status 

761012 

DEVST (6) 

Clear  Output  Buffer  Status 

When  a packet  is  to  be  read  by  the  PDP-11,  the  input  buffer  status 
register  (DEVST(3))  is  odd.  The  packet  is  then  read  a word  at  a 
time  using  DEVST(l).  Since  the  interface  operates  at  a 560  Kilo- 
baud rate,  a timing  loop  must  be  executed  between  word  reads 
accomplished  by  a null  DO  loop  from  1=1  to  3 or  more.  A total 
of  129  word  reads  are  performed  with  the  first  word  read  ignored. 
Consecutive  bytes  are  stored  in  the  16-bit  words  in  the  order 
least  significant  (right) , most  significant  (left)  byte.  After  the 
packet  is  read  DEVST(5)  clears  the  Input  Buffer  Status  Register 
to  zero.  Writing  a packet  to  the  loop  is  accomplished  in  a 
similiar  manner  except  DEVST(4)  is  odd  when  the  output  buffer  is 
empty,  DEVST(2)  is  used  for  128  word  writes,  and  DEVST(6)  is  used 
to  clear  the  Output  Buffer  Status  Register. 


Application  programs  communicate  with  the  six  M1710  board  registers 
via  a COMMON  BLOCK  DATA  program  which  is  installed  into  a DEVICE 
type  partition  M1710.  The  procedure  for  generating  this  interface 
is  listed  below: 


a) 


Create  the  M1710  DEVICE  partition  using  the  MCR  command, 
SET  /MAIN  = Ml710:7610: 1 :DEV 


•* 


Note:  It  may  be  necessary  to  first  remove  any  other  partitions 

that  overlap  the  memory  space  761000-761100  using  the  SET  /b  ,;."MN 
command. 
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b)  Compile  the  M1710.FOR  BLOCK  DATA  program  listed  below  (M1710.FOR 
and  M1710 . OBJ  both  reside  on  ESM  Tape  #1). 

c)  Build  the  M1710  task  and  symbol  table  into  UIC  [1,1]  using  the 
task  builder  utility  (TKB) . 

TKB  [1,1]M1710. TSK/PI , TT0:/SH,  DPO : [ 1 , 1 ] M1710 . STB/-HD 
= [20,20]M1710 .OBJ 

Note:  For  host  processor  B use  DKO  rather  than  DPO. 

Enter  Options: 

STACK=0 

UNITS=0 

PAR=  M1710 : 0 : 100 

d)  Install  the  M1710  task  into  the  M1710  partition  using  the 
MCR  command, 

INS  [1,1] M17 10/PAR=M17 10 

e)  For  application  programs  interfacing  to  the  ESM  loop,  include 
the  FORTRAN  statements 

INTEGER  DEVST ( 6 ) 

COMMON /Ml 7 1 0/DE VST 

and  use  the  TKB  option  when  building  the  task, 

COMMON =Ml 7 10 : RW 
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1.3  User  Language 

The  ESM  User  Language  provides  the  Host-CRT  dialogue  described  in 
Section  4.4  of  the  ESM  User  Manual.  The  User  Language  consists  of 
a main  program  module  (P0000)  and  ten  subroutine  modules  (P1000, 
P2000 , P3000 , P3001,  P4000,  P4001,  P5000,  RDLOOP , WRLOOP,  HST) 
residing  on  ESM  Tape  #1.  The  User  Language  Task  is  contained  in 
UIC  [20,20],  and  it  exists  in  two  forms:  USRLN5.TSK  for  processor 
B loop  2,  and  USRLN1.TSK  for  processor  A loop  1.  The  above  listed 
modules  are  used  for  USRLN5.  Modules  P00001,  P10001,  P40001, 

P40011,  and  HST1  are  used  for  USRLNl.  Modules  P2000,  P3000, 

P3001,  RDLOOP,  and  WRLOOP  are  the  same  for  the  two  processors. 

The  differences  result  primarily  from  the  different  addresses  used 
in  the  LID  pair  header  word  (ICODE(3)).  Header  control  character 
format  is  given  in  Table  5-1  of  t.he  ESM  User  Manual.  Other 
differences  are  found  in  the  main  program  module  (P0000) . Pro- 
cessor A uses  the  DECSCOPE  designated  as  TTO : for  the  message  log 
while  Processor  B uses  DESCOPE  TT1:.  The  message  log  contains  the 
header  and  first  two  information  bytes  of  all  packets  into  the 
host  processor  and  all  dialogue  messages  destined  to  terminals. 

The  input  messages  are  displayed  as  octal  16-bit  words  with  the 
first  arriving  byte  stored  as  least  significant  (e.g.,  D2  Dl 
D4  D3  D6  D5  D8  D7) . 

The  program  normally  waits  for  an  input  packet  from  the  loop  while 
checking  the  input  buffer  status  residing  in  the  M1710  common 
area.  When  the  packet  is  received  the  program  passes  control 
to  the  proper  module  depending  on  the  status  of  the  dialogue 
for  the  terminal  that  sent  the  packet.  The  input  is  processed  and 
responses  are  formatted  and  sent  to  the  loop  to  prompt  the  sending 
terminal  and  provide  system  control  functions  when  necessary. 

The  User  Language  is  divided  into  five  modes  of  operation: 

1.  CRT-to-CRT  (P1000) 

2.  System  Inquiry  (P2000)  : Operates  on  system  file  INFO . DAT . 

3.  System  Control  (P3000,  P3001):  Operates  on  system  file  INFO.DAT. 

4.  File  Access  (P4000,  P4001,  HST)):  Uses  directory  file  EFDIR , 
and  ATEC  simulation  files EFLOCF,  EFTRKD , EFTERD,  EFCKTD . Imple- 
ments a distributed  file  system  where  records  of  a file  are 
distributed  between  host  processors  A and  B. 

5.  Card  Format  (P5000) : Not  yet  implemented. 

Host  processor  A does  not  have  access  to  modes  2 and  3 so  that 
system  control  update  changes  to  INFO.DAT  are  only  stored  on 
processor  B.  Mode  5 on  processor  B contains  a CRT  broadcast 
demonstration  where  all  terminals  receive  a common  packet.  The 
file  MSG. DAT  is  used  for  holding  80  character  records  that  are 
used  for  terminal  displays. 
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Other  files  on  ESM  Tape  #1  related  to  User  Language  operation 
include : 

- INFOPM. OBJ  - This  file  contains  a permanent  copy  of  the 
system  file  INFO . DAT . To  rebuild  this  file  move  INFOPM. OBJ  from 
tape  to  disk  using  the  FLX  FB:80.  fixed  binary  option,  rename  the 
file  to  INFOPM.DAT  and  then  invoke  the  STESM  command  file  which 
deletes  the  old  INFO.DAT  file  and  makes  a new  copy  from  INFOPM.DAT. 

-EFDIR.OBJ , EFTERD.OBJ,  EFCKTD . OBJ , EFTRKD.OBJ,  EFLOCF.OBJ  - 
These  files  are  permanent  copies  of  the  ATEC  simulation  files. 

To  rebuild  these  files  move  EFDIR.OBJ  from  tape  to  disk  using  the 
FLX  FB:200.  fixed  binary  option,  and  EFTERD.OBJ,  EFCKTD. OBJ, 
EFTRKD.OBJ,  EFLOCF.OBJ  using  FB:240.  When  files  have  been  moved 
to  disk,  rename  to  drop  the  .OBJ,  and  build  a consistent  distri- 
buted file  system  without  multiple  copies  using  the  record  move 
utility  (RCMV1,  RCMV5) . 

- MSG. OBJ  - This  file  contains  a permanent  copy  of  the  message 
terminal  display  file  (MSG. DAT) . This  file  may  be  edited  using 
the  RXS11M  EDI  utility  to  obtain  modified  displays. 

The  following  pages  describe  task  building;  overlay  structure; 
variables,  files,  and  library  functions  used;  flowcharts  and 
program  listings  for  the  ESM  User  Language. 


J 
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Task  Building: 

TKB  [20,20] USRLNG.TSK= [20,20] USROVL. ODL/MP ,[1,1] SYSLIB/LB : $SHORT 
Options : 

UNITS=8 

ACTFIL=8 

COMMON=M1710:RW 

ASG=TT1 : 1 , SYO : 2 : 3 : 4 : 5 : 6 : 7 : 8 

MAXBUF=24  0 

The  RSX11M  task  builder  utility  (TKB)  is  used  to  build  the  User 
Language  task  from  the  object  files  of  the  main  program  and  sub- 
routines and  the  overlay  description  language  file.  The  commands 
listed  above  build  the  task.  Shown  below  is  the  overlay  structure 
of  the  program. 


P0000 (main  program) 

P1000  P2000  P3000  P4000  P5000  RDLOOP  WRLOOP  H5 

P3001  P4001 

This  structure  is  coded  in  the  overlay  descriptor  language  file 
[20,20] USROVL . ODL . 

MAIN  PROGRAM  - P0000: 

Important  Variables: 

ST  NOREC  I 1ST 

IND  ICODE  ICON 

DEVST  NRCNO  NN 

Important  Files: 

MSG. DAT 

Fortran  Library  Functions  Used: 

IAND 

ISHFT 

SUBROUTINE  P1000: 

Important  Variables: 

ST  MOUT  NRCNO 

IND  MSK  NOREC 

ICODE  ICFLG  ICON 

Important  Files: 

MSG. DAT 
INFO.DAT 

Fortran  Library  Functions  Used: 

IAND 


SUBROUTINE 

P2000 : 

Important 

Variables : 

ST 

NRCNO 

NDI 

IND 

NOREC 

ICODE 

ND 

MOUT 
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LSK  NR 

Important  Files: 

INFO . DAT 
MSG . DAT 

Fortran  Library  Functions  Used: 
IAND 
ISHFT 

SUBROUTINE  P3000: 


Important  Variables: 

ST  MOUT  NR 

IND  NRCNO  ICHAR 

LSK  NOREC  LIDTBD 

ICODE  ICON  MSK 

Important  Files: 

INFO . DAT 
MSG. DAT 

Fortran  Library  Functions  Used: 
IAND 
ISHFT 


ICFLG 

INFA 

INV 

NEWV 


SUBROUTINE  P3001: 

Important  Variables: 

ST  NRCNO  NDWPMD 

IND  LSK  NIM 

NR  ICODE  ICHAR 

NOREC  MSK 

Important  Files: 

INFO.DAT 

Fortran  Library  Fuctions  Used: 
IAND 


SUBROUTINE  P4000: 
Important  Variables: 


ST 

NRNCO 

ICODE 

OFIL 

KEYTYPEFM 

IND 

NOREC 

DI 

MOUT 

I FAC 

IFS 

LSK 

LU 

NOCHARKEY 

Important 

Files : 

EFDIR 

EFLOCF 

EFTRKD 

MSG . DAT 

EFCKTD 

EFTERD 

Fortran  Library  Function  Used: 
IAND 


SUBROUTINE  P4001: 
Important  Variables: 


ST 

ICODE 

MOUT 

NOREC 

LINE 

IND 

DI 

OFIL 

LSK 

I FAR 

IFS 

LU 

NRCNO 

NOCHARKEY 

KEYTYPEFM 

Important  Files: 

MSG. DAT  EFLOCF  EFTRKD 

EFDIR  EFCKTD  EFTERD 


I FAC 
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Fortran  Library  Functions  Used: 
IAND 

SUBROUTINE  P5000: 


Important  Variables: 
ST  NOREC 

LSK  NRCNO 

Important  Files: 


IND 

ICODE 


Fortran  Library  Functions  Used: 
IAND 

SUBROUTINE  RDLOOP: 

Important  Variables: 

DEVST 

ICODE 

Important  Files: 


Fortran  Library  Functions  Used: 
MOD 

SUBROUTINE  WRLOOP : 

Important  Variables: 

I1ST  ICODE 

DEVST 

Important  Files: 


Fortran  Library  Functions  Used: 

MOD 

SUBROUTINE  HST : 

Important  Variables: 

ST  DI  OFIL  MOUT 

NRCNO  NOREC  ICODE 

Important  Files: 

MSG. DAT  EFLOCF  EFTRAD 

EFDIR  EFCATD  EFTERD 

Fortran  Library  Functions  Used: 
IAND 


DESCRIPTION  OF  VARIABLES  USED: 

ST  - ST  is  the  status  array.  ST  is  of  type  INTEGER  and  is  dimensioned 
(3,9).  The  first  parameter  of  ST  (IND)  indicates  the  user  (CRT  #1, 

2 or  3) . The  second  contains  a maximum  of  9 statuses.  Status  1 is 
the  module  status.  Status  2 is  the  CRT -CRT  node  designator.  Only 
values  of  4 and  8 are  allowed.  Status  3 is  the  type  of  system  infor- 
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mation  desired.  Values  of  1 - 4 are  permitted.  Status  4 is  the  node 
designator  for  modules  P3000  and  P3001  with  values  of  1 - 11  allowed. 
Status  5 is  the  network  device  parameter  with  values  of  1 - 4 per- 
missable.  Status  6 contains  the  "KEY"  to  be  checked  in  the  directory. 
Status  7 is  the  record  number  of  the  file  with  the  correct  "KEY". 
Statuses  8 and  9 are  different  types  of  cross-referencing.  Values 
of  1 to  3 are  allowed. 

IND  - IND  identifies  the  user  as  being  CRT  #1,  2 or  3. 

DEVST  - DEVST  contains  the  six  registers  of  the  added  COMMON  area 
M1710  which  corresponds  to  the  M1710  Interface  Board  Memory  Partition. 
This  allows  the  PDP-11  to  talk  to  the  B7*  microprocessor.  DEVST  is 
of  type  INTEGER  and  is  dimensioned  at  6. 


ICODE  -ICODE  is  formed  by  RDLOOP  by  getting  the  values  of  DEVST (1) 
from  the  B7*  interface  buffer.  ICODE  is  dimensioned  at  128.  ICODE  (3) 
is  used  for  the  LOGICAL  I.D.'s. 


ICON  - ICON  is  the  control  packet  array.  It  is  put  into  ICODE  and 
is  written  out  to  the  loop.  ICON  is  dimensioned  at  128. 

ICFLG  -ICFLG  is  either  0 or  1.  When  equal  to  1 it  indicates  to  the 
modules  that  ICON  exists  and  there  is  a control  packet  to  be  written 
to  the  loop. 

ICHAR  - ICHAR  is  used  in  the  process  of  changing  the  header  (ICODE  (1  - 
4))  from  type  INTEGER  to  type  REAL* 8.  ICHAR  is  type  INTEGER  and  is 
dimensioned  at  4. 

NEWV , LIDTBD,  LDNFAD , NDWPMD  - NEW,  LIDTBD , LDNFAD  are  used  in 
P3000  and  NDWPMD  in  P3001.  They  are  all  equivalent  with  ICHAR. 

They  receive  the  value  of  ICHAR  (INTEGER  type)  and  hold  it  as  type 
REAL*8.  They  hold  the  first  4 words  that  were  sent  by  the  loop  to 
the  PDP-11  processor. 

I1ST  - I1ST  is  sent  as  a parameter  from  -0000  to  the  module  WRLOOP. 

It  is  equal  to  0 before  the  first  PDP-11  write  to  the  loop  and  1 
after  the  first  write. 

NRCNO  and  NOREC  - NRCNO  and  NOREC  are  pointers  to  the  file  MSG. DAT. 
Certain  combinations  of  these  two  variables  correspond  to  messages 
that  are  sent  to  the  CRT's.  Both  are  of  type  INTEGER. 

NN  - NN  is  ',ed  in  P0000  as  the  pointer  to  the  records  to  be  read  in 
from  MSG.Drtr  into  ICODE. 

LU  - LU  is  the  logical  unit  number  variable  corresponding  to  the 
file  that  MOUT  is  to  be  written  to.  LU  is  equal  to  3 , 4,  5 , or  6 
respectively  corresponding  to  the  files  EFLOCF,  EFCKTD , EFTRKD , 
and  EFTERD.  LU  is  of  type  INTEGER. 


MOUT  - MOUT  is  of  type  REAL*8  and  is  dimensioned  (10,  11).  Records 
are  read  from  MSG. DAT  and  INFO . DAT  into  MOUT  and  MOUT  is  written  to 
the  different  files  and  eventually  to  the  DECSCOPE. 


DI  - DI  is  the  queue  for  the  directory  of  the  files.  In  P4000,  DI 
is  checked  to  see  if  the  "KEY"  exists.  DI  is  of  type  INTEGER  and 
is  dimensioned  at  100. 


1 
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OFIL  - Records  from  the  files  with  logical  unit  numbers  3 -6  are 
written  in  OFIL.  It  is  used  on  modules  P4000  and  P4001.  It  is  of 
type  REAL* 8 and  is  dimensioned  (10,  3). 


LSK  - LSK  is  the  least  significant  mask.  LSK  equals  a bit  pattern 
01111111.  LSK  and  ICODE  are  used  with  the  FORTRAN  function  I AND  for 
bit  manipulation. 

MSK  - MSK  is  the  most  significant  mask.  MSK  equals  a bit  pattern  of 

0111111100000000.  MSK  and  ICODE  are  used  with  the  FORTRAN  function 
IAND  for  bit  manipulation. 

I FAC  - I FAC  is  dimensioned  at  3 and  is  of  type  INTEGER.  IFS  is  a 
local  variable  which  holds  the  value  of  IFAC(IND).  IFAC(l)  holds  the 
file  to  be  accessed  by  CRT#1.  Permissable  values  of  IFS  (or  IFAC  (1, 

2 or  3))  are  1 -4.  If  the  value  is  greater  than  4,  IFS  is  defaulted 
to  4 . 

ND  - ND  is  of  type  INTEGER.  It  is  used  in  P2000  as  the  value  of  the 
anding  of  LSK  or  MSK  and  ICODE. 

NR  - NR  is  the  variable  corresponding  to  the  record  number  of  the 
file  MOUT  is  written  to.  NR  is  of  type  INTEGER. 

NDI  - NDI  is  equal  to  the  hollerith  equivalent  of  "NDI  ".  In 

P2000,  a test  is  made  to  see  of  ND  is  equal  to  NDI.  NDI  is  of 
type  REAL* 8. 

INV  - INV  aids  in  the  creation  of  the  control  packet.  INV  is  the 
decimal  representation  of  INVH,  INVT  and  INVO  combined.  INV  is  of 
type  INTEGER. 

NFA,  INFA  - INFA  is  dimensioned  at  4 and  is  of  type  INTEGER.  Because 
INFA  is  equivalent  with  NFA,  whatever  value  that  goes  into  INFA  is 
also  stored  in  NFA.  However,  the  value  stored  in  NFA  is  of  type 
REAL* 8.  NFA  is  then  tested  against  the  input  and  output  array,  MOUT. 

NIM  - NIM  is  equal  to  the  hollerith  equivalent  of  "NOT  IMPL".  NIM 
is  of  type  REAL* 8. 

LINE,  I FAR  - LINE  and  IFAR  are  EQUIVALENT.  LINE,  dimensioned  at  40, 
receives  its  values  from  ICODE  as  type  INTEGER,  transfers  its  value 
to  IFAR,  dimensioned  at  10,  as  type  REAL*8  through  their  equivalence, 
OFIL  receives  IFAR's  values. 

NOCHARKEY,  KEYTYPEFM  - NOCHARKEY  and  KEYTYPEFM  are  for  display  pur- 
poses. NOCHARKEY  tells  the  number  of  characters  per  key  and  KEYTYPEFM 
tells  the  form  the  key  is  in  (either  letter  - digit,  alpha-numeric 
or  digit) . Both  are  dimensioned  at  10  and  are  of  type  INTEGER. 


i 


DESCRIPTION  OF  FILES  USED: 

EFDIR  - EFDIR  is  the  directory  file.  It  has  a logical  unit  number 
of  2,  10  records,  100  words  per  record  and  is  unformatted. 
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EFLOCF , EFCKTD , EFTRKD , EFTERD  - These  are  the  files  ATEC  - SIMULATION 
that  EFDIR  refers  to.  Respectively,  their  logical  unit  numbers  are  3, 
4,  5 and  6.  Each  contains  100  records  with  each  record  being  120 
words  in  length.  Each  file  is  also  formatted. 

INFO . DAT  - INFO . DAT  is  the  system  information  file.  It  has  a logical 
number  of  7.  The  file  has  396  records  with  40  words  per  record.  It 
is  unformatted. 

MSG. DAT  - MSG. DAT  contains  all  the  messages  to  be  displayed  to  the 
CRT's.  It  has  a logical  unit  number  of  8.  It  contains  211  records 
with  each  record  being  unformatted  and  40  words  in  length. 


DESCRIPTION  OF  THE  FORTRAN  LIBRARY  FUNCTIONS  USED: 

IAND(m,n)  - This  function  logically  ands  m and  n bit  by  bit. 

ISHFT (m, n)  - m designates  the  argument  to  be  shifted  and  n specifies 
the  number  of  positions  and  the  direction  m is  to  be  shifted. 

MOD ( I , J ) - This  function  divides  I by  J and  gives  the  value  of  the 
remainder.  The  value  is  of  type  INTEGER. 
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Table  B gives  the  flowchart  letter  connectors  and  their  correspond- 
ing positions  in  the  User  Language  program. 

TABLE  B 

FLOWCHART  PROGRAM 

LETTER  CONNECTOR  LOCATION  (MODULE  - LABEL) 


A 

P0000 

- 

25 

B 

P0000 

- 

12 

C 

P0000 

- 

250 

D 

P0000 

- 

330 

G 

P1000 

- 

14 

H 

P1000 

- 

53 

I 

P1000 

- 

54 

J 

P1000 

- 

30 

K 

P2000 

- 

53 

L 

P200C 

- 

72 

M 

P2000 

- 

51 

N 

P3000 

- 

102 

0 

P4000 

- 

22 

P 

P4000 

- 

23 

Q 

P4000 

- 

24 

R 

P4000 

- 

25 

T 

P4000 

- 

575 

U 

P4000 

- 

580 

V 

P4000 

- 

585 

W 

P4001 

- 

28 

X 

P4001 

- 

29 

Y 

P4001 

- 

30 

Z 

P4001 

- 

31 

AA 

P4001 

- 

32 

BB 

P4001 

- 

34 

CC 

P5000 

- 

21 

DD 

P5000 

- 

24 

EE 

P3000 

- 

250 

NRCNO=2l 
NOREC  = l 


ICODE(l>  X 
MSGNO(IND) 


MSGNO(IND) 

=lCODE(l) 


ICODE(3) 


ICODE(3) 

=IHC8 


ICODE(3) 
= IHC9 


ICODE(4) 
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C 

C PRELIM  USER  LANG  PROG 

C WRITTEN  IN  FORTRAN  IV 

C 

0001  REAL*8  ND I .LID.  TAB  » NWD  » MOUT 
1 , SN8 , CRT I NMSG  * ND 

0002  REAL*8  Q20,a4CJ,KEYTYF'EFM,0FIL, DI 

0003  INTEGER  ST 

0004  INTEGER  DEVST<6> 

0005  DIMENSION  OF IL < 1 0 . 3 ) . DI (100 > 


0006 

0007 

0008 

0009 

0010 
0011 
0012 

0013 

0014 

0015 

0016 

0017 

0018 

0019 

0020 

0021 

0022 

0023 

0024 

0025 


0026 

0027 

0028 

0029 

0030 

0031 

0032 

0033 

0034 

0035 

0036 

0037 

0038 

0039 

0040 

0041 

0042 

0043 

0044 

0045 


DIMENSION  MSGNO ( 3 ) 

COMMON  /M1710/DEVST 

COMMON  /LOOP/  IC0DEU28)  .MSK.LSK 

DATA  MSK.LSK/"77400, "177/ 

COMMON  NDI .LID.TAD.NWD.ST (3.9) » IND 

COMMON  /UOOO/  MOUT (10.11). NRCNO . NOREC 
COMMON  /DSK/I1 . 12. 13. 14. 15. 16. 116 
COMMON  /MD04/N0CHARKE Y (10).  KEYTYF'EFM (10) 

COMMON  /FO 1/IFAC ( 3 ) 

COMMON  /CPAC/ICON( 128) . ICFLG 
COMMON  /S230/  ND 

DATA  NDI .LID » TAB. NUD . SK8/ 'NDI  ', 

l'LID  '.'TAB  ','NNWD  '.'  '/ 

DATA  ISF'C  /’ 120240/ 

DATA  ICRLF  /’106412/ 

DATA  LF.LH0ME.LE0P.LFF4.LFF5.IDC1/* 12. '24. *177777. 
1*14. *5000. *10400/ 

DATA  IC4H. IHC4. IC3H. IHC8/* 2005. *2404. *4005. *2410/ 
DATA  ILO/ *51504/ 

DATA  IC9H.IHC9/*4405. *2411/ 

DATA  IH15/ ' 405/ 

15  FORMAT ( IX . 1 0A8 ) 

C START  DIALOGUE 

C IND  IS  THE  PAIR  INDEX  NUMBER 

C ST  IS  THE  STATUS  ROUTINE  * ARRAY 

DO  20  IND=1 . 3 
MSGNO( IND) =0 
20  ST ( I ND , 1 ) =000 1 

C THROW  AWAY  PACKET  TO  HAVE  B7*  INP  BUF  INIT  EMPTY 
DO  130  J=  1 » 1 29 
DO  140  1=1,70 
140  CONTINUE 
130  K=DEVST ( 1 ) 

1 1ST =0 
ICFLG=0 
DO  22  J=l,ll 
DO  22  1=1,10 
22  MOUT ( I » J) =SK8 

CALL  ASSIGN( 1 , ' TT1 • ' ) 

CALL  ASSIGN  <2,'EFDIR'> 

DEFINE  FILE  2 < 10 , 100 , U , I 1 > 

CALL  ASSIGN(3, ' EFLOCF ' > 

DEFINE  FILE  3 ( 100 , 1 20 , U , 1 2 ) 

CALL  ASSIGN ( 4, 'EFCKTD' > 

DEFINE  FILE  4 ( 1 00 , 1 20 , U . 1 3 ) 

CALL  ASSIGN(5» 'EFTRND' > 
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0046 

0047 

0048 
004? 

0050 

0051 


DEFINE  FILE  5 < 1 00 r 1 20 . U » 1 4 ) 
CALL  ASSIGN (6i 'EFTERD ' ) 
DEFINE  FILE  6 ( 1 00 . 1 20 . U . 15 ) 
CALL  ASSIGN ( 7 » ' INFO . DAT ' > 
DEFINE  FILE  7 ( 396 » 40 . U . I 6 ) 
CALL  ASS  I GN ( 8 » ' MSG . DAT ' ) 


0052 

0053 

0054 

0055 

0056 

0057 

0058 

0059 

0061 

0062 

0064 

0066 

0068 

0070 

0072 

0074 

0075 

0076 
0078 
0080 
0082 

0083 

0084 

0085 

0086 


DEFINE  FILE  8 ( 21 1 . 40 , U . I 1 6 ) 

DEVST  < 5 ) -0 
DO  23  LU=3  . 6 

23  READ ( LU ' 1 » ERR=1 7 ) ( ( OFIL (I » J ) » 1 = 1 » 1 0 > » J=1 » 3 ) 

25  CALL  RDLOOP 
C CALC  IND.  FORM  LIDS 
D WRITE ( 1 . 1 6 ) ( I CODE ( J ) » J=1 > 4 > 

D16  FORMAT ( 1X» 'HEADER*  '.408) 

IF  ( I CODE ( 4 ) ,E0.  *41101  .AND.  (IC0DE(5)  .EQ. 
1 ICODE ( 5 ) .EQ.  *151317))  GOTO  500 
IND=4‘ 

IF  ( ICODE (3)  .EQ.  IH15)  GOTO  700 

IF  ( ICODE ( 3 ) .EQ.  IC4H)IND=1 

IF  ( ICODE < 3 ) .EQ.  IC8H)  IND=2 

IF  ( I CODE ( 3 ) .EQ.  IC9H)  IND=3 

IF  < IND  .EQ.  4)  GOTO  25 

IF  ( ICODE ( J ) .EQ.  MSGNO(IND))  GOTO  25 

MSGNO ( IND )= ICODE ( 1 ) 

ICODE ( 3 > = IHC4 

IF  (IND  .EO.  2)  I CODE ( 3 > “ IH08 
IF  (IND  .EQ.  3)  I CODE ( 3 ) = IHC9 
IF  ( ICODE < 4 ) . NE . ILO)  GOTO *630 
NRCNO-21 
NOREC* 1 

ST( IND. 1 >=9999 
GOTO  12 
700  CALL  HST 


0087 

IF  (NOREC  .EQ.  0) 

GOTO  25 

0089 

GOTO  12 

0090 

630 

IF  ( ST  < IND . 1 > .EQ. 

0001 ) 

GOTO 

51 

0092 

IF  (ST(IND.l)  .EQ. 

0002) 

GOTO 

52 

0094 

IF  (ST(IND.l)  .EQ. 

0003) 

GOTO 

53 

0096 

IF  (ST(IND.l)  .EQ. 

0004) 

GOTO 

54 

0098 

IF  (ST(IND.l)  .GE. 

1000) 

GOTO 

1 

0100 

GOTO  2 

0101 

1 

IF  (ST(IND.l)  .LE. 

199?) 

GOTO 

61 

0103 

2 

IF  (ST ( IND. 1 ) .GE. 

2000) 

GOTO 

3 

0105 

GOTO  4 

0106 

3 

IF  ( ST ( IND . 1 ) .LE. 

299?) 

GOTO 

62 

0108 

4 

IF  (ST(IND.l)  .GE. 

3000) 

GOTO 

5 

0110 

GOTO  6 

0111 

5 

IF  (ST(IND.l)  .LE. 

399?) 

GOTO 

63 

0113 

.6 

IF  (ST ( IND . 1 ) .GE. 

4000) 

GOTO 

7 

0115 

GOTO  8 

0116 

7 

IF  (ST ( IND . 1 > .LE. 

4999) 

GOTO 

64 

0118 

8 

IF  (ST(IND.l)  .GE. 

5000) 

GOTO 

9 

0120 

GOTO  12 

0121 

9 

IF  (ST(IND.l)  .LE. 

5999) 

GOTO 

65 

0123 

51 

NRCNO= 1 

0124 

N0PEC=2 

*51117  .OR. 
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0125 

ST  < I ND » 1 ) =0002 

0126 

GOTO  12 

0127 

52 

NRCN0=3 

0128 

N0REC=1 

0129 

ST  ( IND » 1 ) =0003 

0130 

GOTO  12 

0131 

53 

NRCN0=4 

0132 

NOREC-7 

0133 

ST<IND,1  >=0004 

0134 

GOTO  12 

0135 

54 

1=1 AND  ( 1.SK  r ICODE ( 4 ) > 

0136 

1=1-48 

0137 

IF  (I  .EO.  1)  GOTO 

101 

0139 

IF  (I  .EQ.  2)  GOTO 

102 

0141 

IF  <1  .EO.  3)  GOTO 

103 

0143 

IF  <1  .EQ.  4)  GOTO 

104 

0145 

IF  <1  .EO.  5)  GOTO 

105 

0147 

17 

NRCNQ= 1 1 

0148 

N0REC=1 

0149 

GOTO  12 

0150 

101 

NRCNO -12 

0151 

N0REC=2 

0152 

ST ( INDf 1 >=1000 

0153 

GOTO  12 

0154 

102 

NRCNQ=22 

0155 

N0REC=5 

0156 

ST ( I ND » 1 ) =2000 

0i57 

GOTO  12 

0158 

103 

NRCNO=70 

0159 

N0REC=6 

0160 

ST< IND » 1 ) =3000 

0161 

GOTO  12 

0162 

104 

NRCN0=127 

0163 

N0REC=6 

0164 

ST  < IND » 1 ) =4000 

0165 

GOTO  12 

0166 

105 

NRCN0=108 

0167 

N0REC=4 

0168 

ST( IND* 1 )=5000 

0169 

GOTO  12 

0170 

61 

CALL  PiOOO 

0171 

GOTO  12 

0172 

62 

CALL  F'2000 

0173 

GOTO  12 

0174 

63 

CALL  F3000 

0175 

GOTO  12 

0176 

64 

CALL  F'4000 

0177 

GOTO  12 

0178 

65 

CALL  F'5000 

0179 

12 

IF  (NOREC  .EO.  0) 

GOTO 

710 

C 

WRITE  TO  LOOP 

0181 

IF  ( NRCNO  .GE.  107) 

NRCNO-NE'CNOl  1 

0183 

DO  200  J=4 . 1 28 

0184 

200 

ICODE ( J ) =0 

0185 

ICODE <1 27 )=LGOP 

0186 

IF  (NRCNO  .NE.  *11) 

GOTO 

210 

I 

I 
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0188 

0189 

0190 

0191 

0192 

0193 

0194 

0195 

0196 

0197 
0199 
0201 

0203 

0204 

0205 

0206 

0207 

0208 
0210 


I CODE  < 4 ) =LHOME 
DO  220  J=5 ,16 
220  I CODE ( J) =LF 

READ < 8 ' 1 1 ) ( I CODE ( I ) , 1=17 , 56 ) 

ICODE  < 57 ) =LtlOME 
ICODE  < 58 ) =LEOP 
CALL  URLOOP (I 1ST) 

GOTO  330 
210  NWRTS=4 

IF  (NOREC  .LE.  3)  NURTS=1 

IF  (NOREC  .GE.  4 .AND.  NOREC  .LE.  6)  NURTS=2 

IF  (NOREC  .GE.  7 .AND.  NOREC  .LE.  9)  NWRTS=3 

NN=NRCNO 

DO-  310  J=1 1 NWRTS 

JJJ=J 

DO  450  K=4 . 1 26 
450  ICODE ( K ) =0 

IF  (J  . EG . 1)  I CODE ( 4 > =LFF4 
IF  (J  .EQ.  1 >'  ICODE ( 5 ) =LFF5 


0212 

0213 

0214 
0216 

0217 

0218 
0219 
0221 
0222 

0223 

0224 

0225 


READ ( 8 ' NN » ERR =500  > ( ICODE ( I > » 1=6 , 45 ) 
N1=(J-1 )*3+l 

IF  (NOREC  .LE.  Nl)  GOTO  250 
NN=NN+1 

READ(8'NN,ERR=500> (ICODE(I) ,1=46.85) 
N2=N1+1 

IF  (NOREC  .LE.  N2>  GOTO  250 
NN=NN+1 

READ(8'NN,ERR=500) (ICODE( I) ,1=86,125) 
NN=NN+ 1 

250  ICODE ( 45 >=ICRLF 
ICODE ( 85 ) =ICRLF 


0226  ICODE (125)=ICRLF 

0227  ICODE (126)=IDC1 

0228  IF  (J  .EQ. NURTS)  ICODE ( 126 ) =LHOME 


0230 

0231 

0232 

0233 

0235 

0236 

0237 

0238 

0239 

0241 

0242 

0243 

0244 

0245 


310 

710 

510 


330 

C 


70 


CALL  URLOOP ( 1 1 ST ) 

I 1ST=1 
CONTINUE 

IF  ( ICFLG  .EQ.  0)  GOTO  330 
DO  510  J=1 , 128 
ICODE ( J ) =ICON ( J ) 

CALL  URLOOP (1 1ST) 

ICFLG=0 

IF  (NOREC  .EQ.  0)  GOTO  25 
WRITE  OUT  SCREEN 
DO  70  J=l, NOREC 
NOR=NRCNO+ J- 1 

READ ( 8 ' NOR ) ( MOUT (I, J), 1=1, 10) 
WRITE ( 1, 15 >( MOUT ( I, J >,1=1,10) 
DO  80  J=l,ll 


I 


0246  DO  80  1=1,10 

0247  80  MOUT ( I , J > =0 

0248  GOTO  25 

0249  500  CONTINUE 

0250  END 
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0001 


0002 

0003 

0004 

0005 

0006 

0007 

0008 

0009 

0010 
0011 
0012 

0013 

0014 

0015 

0016 

0017 

0018 

0019 

0020 

0021 

0022 

0023 

0024 

0025 

0026 


0027 

0028 

0029 

0030 

0031 

0032 

0033 

0034 

0035 

0036 

0037 

0038 

0039 

0040 

0041 

0042 

0043 

0044 

0045 


C 

C PRELIM  USER  LANG  PROG 

C WRITTEN  IN  FORTRAN  IV 

C 

REAL*8  NBI .LID, TAB.NWD.MOUT 
1 » SK8 .CRTINMSG  , NB 
REAL*8  020 , 040 , KEYT  YF'EFM , OFIL  f PI 
INTEGER  ST 
INTEGER  DEVST ? 6 > 

DIMENSION  OFIL?10,3),DI?100> 

DIMENSION  MSGNO ? 3 ) 

COMMON  /M1710/DEVST 

COMMON  /LOOP/  ICODE ( 128 ) f MSK , LSK 

DATA  MSK , LSK/ *77400.* 177/ 

COMMON  NDI , L I D . TAB , NUD , ST ( 3 , 9 ) , I ND 

COMMON  /UOO 0/  MOUT(lOrll) .NRCNO.NOREC 
COMMON  /nSK/Il»I2,I3,I4,I5,I6,I16 
COMMON  /MD04/N0CHARKEY ? 1 0 ) , KEYT  YF'EFM  < 10 ) 

COMMON  /F01/IFAC < 3 ) 

COMMON  /CF'AC/ICON?  128)  > ICFLG 
COMMON  /S230/  ND 
DATA  NDI j L I D » TAB > NWD i SK8/ 'NDI 
1 'LID  '.'TAB  ','NNUD  '.'  '/ 

DATA  ISPC  /■ 120240/ 

DATA  ICRLF  /■ 106412/ 

DATA  LF.LH0ME.LE0P.LFF4.LFF5. IDC1/* 12. "24. ■ 177777. 
1 1 14 , *5000. ‘10400/ 

DATA  IC4H. IHC4. ICbH . IHC9/ ‘ 2001 . *404. ‘4001 . ‘410/ 
DATA  ILO/ * 51504/ 

DATA  IC9H.IHC9/‘4401. ‘411/ 

DATA  IH1 5/ ‘405/ 

DATA  IH51/‘2401/ 

15  FORMAT ( IX  > 1 0A8  > 

C START  DIALOGUE 

C IND  IS  THE  PAIR  INDEX  NUMBER 

C ST  IS  THE  STATUS  ROUTINE  * ARRAY 
DO  20  IND=1 .3 
MSGNO ( IND )=0 
20  ST< IND, 1 >=0001 

C THROW  AWAY  PACKET  TO  HAVE  B7*  INP  BUF  INIT  EMPTY 
DO  130  J=1 » 1 29 
DO  140  1=1,70 
140  CONTINUE 
130  K=DEVST<1) 

I 1 ST=0 
ICFLG=0 
DO  22  J'-l.ll 
DO  22  1*1,10 
22  MOUT ( I » J)=SK8 

CALL  ASSIGN? 1 , ' TTO! ' > 

CALL  ASSIGN  <2,'EFDIR'> 

DEFINE  FILE  2 ( 1 0 , 1 00 , U , I 1 ) 

CALL  ASSIGN ( 3. 'EFLOCF' > 

DEFINE  FILE  3 < 1 00 , 1 20 . U , 12 ) 

CALL.  ASSIGN?  4 , ' EFCKTD ' ) 

DEFINE  FILE  4? 100, 120. U. 13) 
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0046 

0047 

0048 

0049 

0050 

0051 

0052 

0053 

0054 

0055 

0056 

0057 

0058 

0059 

0060 

0062 

0063 

0065 

0067 

0069 

0071 

0073 

0075 

0076 

0077 
0079 
0081 

0083 

0084 

0085 

0086 


CALL  ASSIGN ( 5 , ' EFTRKD ' > 

DEFINE  FILE  5 < 1 00 , 1 20 . II , 14 ) 

CALL  ASS  I GN  E 6 » ' EFTERD ' ) 

DEFINE  FILE  6(100,120,0,15) 

CALL  ASSIGN ( 7 » ' INFO . DAT ' ) 

DEFINE  FILE  7 E 396 , 40 . U . 16  ) 

CALL  ASSIGNED, 'MSG. DAT' ) 

DEFINE  FILE  8(211,40.11.116) 

DEVST  < 5 > =0 
DO  23  LU=3 , 6 

23  READ ( LU ' 1 , ERR=1 7 HE OFIL ( I , J ) . 1 = 1 » 1 0 ) , J=1 , 3 ) 
25  CALL  RDLOOP 
C CALC  IND.  FORM  LIDS 
D WRITE ( 1 , 16 ) ( I CODE (J>»J=1»4) 

D16  FORMATE  IX, 'HEADER*  '.408) 

IF  ( I CODE ( 4 ) .EQ.  *41101  .AND.  ( IC0DEE5) 

1 I CODE (5 ) .EO.  *51117))  GOTO  500 


EQ.  *151317  .OR. 


IND=4 

IF  (IC0DEE3) 

IF  ( ICODE ( 3 ) 

IF  ( ICODE ( 3 ) 

IF  E ICODE  E 3 ) 

IF  EIND  .EO. 

IF  < ICODE ( 1 ) 

MSGNO ( IND )=IC0DEE1 > 
ICODE ( 3 > = IHC4 


.EQ. 

.EQ. 

.EQ. 

.EQ. 


IH51 ) GOTO  700 
IC4H) IND=1 
IC8H)  I ND=2 
IC9H)  I ND  = 3 
4)  GOTO  25 

.EQ.  MSGNO ( IND ) > GOTO  25 


IF  (IND  .EQ. 

IF  (IND  .EQ. 

IF  ( ICODE ( 4 ) 
NRCN0=21 
N0REC=1 

STE IND, 1 >=9999 
GOTO  12 


2)  ICODE ( 3 ) = IHC8 

3)  ICODE  ( 3 > = 1IIC9 
.NE.  ILO ) GOTO  630 


0087 

700 

CALL  HST 

0088 

IF  (NOREC  .EQ. 

0) 

GOTO  25 

0090 

GOTO  12 

0091 

630 

IF  ( ST ( IND , 1 ) 

.EQ. 

0001  ) 

GOTO 

51 

0093 

IF  (STEIND.l) 

.EQ. 

0002) 

GOTO 

52 

0095 

IF  (STEIND.l) 

.EQ. 

0003) 

GOTO 

53 

0097 

IF  (STEIND.l) 

.EQ. 

0004  ) 

GOTO 

54 

0099 

IF  (STEIND.l) 

.GE. 

1000) 

GOTO 

1 

0101 

GOTO  2 

0102 

1 

IF  (STEIND.l) 

.LE. 

1999) 

GOTO 

61 

0104 

2 

IF  (STEIND.l) 

.GE. 

2000) 

GOTO 

3 

0106 

GOTO  4 

0107 

3 

IF  (STEIND.l) 

.LE. 

2999) 

GOTO 

62 

0109 

4 

IF  (STEIND.l) 

.GE. 

3000) 

GOTO 

5 

0111 

GOTO  6 

0112 

5 

IF  (STEIND.l) 

.LE. 

3999) 

GOTO 

63 

0114 

6 

IF  (STEIND.l) 

.GE. 

4000) 

GOTO 

7 

0116 

GOTO  8 

0117 

7 

IF  (STEIND.l) 

.LE. 

4999) 

GOTO 

64 

0119 

8 

IF  (STEIND.l) 

.GE. 

5000) 

GOTO 

9 

0121 

GOTO  12 

0122 

9 

IF  (STEIND.l) 

.LE. 

5999) 

GOTO 

65 

0124 

51 

NRCN0=1 
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FORTRAN  10 

0018-02 

FRI 

18  HAR  77  10151  SHI  F’AGF  003 

ClIRi  = 

00K  * U 

ID  C 20. 203 

I 00001 .OBJ  POOOOl .FOR/NOGN/liE/LI 1 1 

0125 

N(lRt  07 

0126 

SI < I N8. 1 ) -000? 

0127 

GOTO  17 

oi?n 

57 

NRCNO-  3 

0129 

N0RI  D 1 

0130 

GT<  I NU > 1 >=*0003 

0131 

GOTO  1? 

0132 

53 

NRCNO  4 

0133 

NORI  C-  7 

0134 

ST ( INP.  1 >'  0004 

0135 

GO  10  12 

0136 

54 

i=ianiki  SR.  irni'r<4>  > 

0137 

I«  1-  48 

0138 

IF  (1  .F  G.  1 ) GOTO 

101 

0140 

ir  <1  .10.  2)  GOTO 

1 07 

0142 

IF  <1  .ro.  3>  GOTO 

1 03 

0144 

IF  (1  .EFT.  4)  G010 

104 

0146 

if  <r  .eg.  r. > gofo 

105 

0148 

17 

NRCNO -1 1 

0149 

NORF  C-^l 

0150 

GOTO  1? 

0151 

101 

NRCNO- 12 

0152 

NORF  C>  7 

0153 

STUN8.1  >'=1000 

0154 

GOTO  1? 

0155 

102 

NRCNO  21 

0156 

nored  1 

0157 

ST  ( I NIT.  1 ) * 9999 

0158 

GOTO  12 

0159 

103 

NRCNO  21 

0160 

NORCO  1 

0161 

ST  ( INP.  1 > '-9999 

0162 

GOTO  12 

0163 

104 

NRCN0=127 

0164 

N0REC=6 

0165 

ST  < I ND . 1 ) -4000 

0166 

GOTO  1? 

0167 

105 

NRCN0=108 

0160 

NOREC =4 

0169 

STTINP. 11=5000 

0170 

GOTO  12 

0171 

61 

CALL  riooo 

0172 

GOTO  12 

0173 

62 

CALL  P2000 

0174 

GOTO  12 

0175 

63 

CALL  P3000 

0176 

GOTO  12 

0177 

64 

CALL  R4000 

0178 

GOTO  12 

0179 

65 

CALL  P5000 

0180 

12 

IF  (NOREC  .EG . 0) 

GOTO 

710 

C 

URITE  TO  LOOP 

01B? 

IF  (NRCNO  .GE.  107) 

NRCNO=NRCNO F 1 

0184 

80  200  J=4 . 1 28 

0185 

o 

o 

ICOPE< J)=0 

0186 

IC08E(127) =LEOP 

r.  ' 


T 


FORTRAN 

IU 

U01  El-02  FRI  18-MAR- 77 

18 

C0RE= 

08K  f UIC=C20f  203  P00001. 

OB  J; 

0187 

IF  (NRCNO  .NE.  11)  GOTO  210 

0189 

ICODE ( 4 ) =LHOME 

0190 

DO  220  J=5 » 1 6 

0191 

220 

I CODE  < J ) =LF 

0192 

READ  < 8 ' 1 1 ) ( I CODE (I)fI=17f  56 ) 

0193 

ICODE ( 57 ) =LHOME 

0194 

ICODE ( 58 ) =LEOP 

0195 

CALL  URI.OOP  ( 1 1ST ) 

0196 

GOTO  330 

0197 

210 

NWRTS=4 

0198 

IF  (NOREC  .LE.  3)  NURTS=1 

0200 

IF  (NOREC  .GE.  4 .AND.  NOREC  .LE. 

6) 

0202 

IF  (NOREC  .GE.  7 .AND.  NOREC  .LE. 

9) 

0204 

NN=NRCNO 

0205 

DO  310  J=1 > NWRTS 

0206 

JJJ=J 

0207 

DO  450  K=4  ? 1 26 

0208 

450 

ICODE ( K ) =0 

0209 

IF  (J  .EQ.  1)  ICODE ( 4 ) =LFF4 

0211 

IF  (J  .EO.  1)  ICODE ( 5 ) =LFF5 

0213 

READ (8'NNfERR=500>( ICODE ( I > f 1-6  f 45 ) 

0214 

Nl  = ( J-l  )#3-l  1 

0215 

IF  (NOREC  .LE.  Nil  GOTO  250 

0217 

NN=NN+ 1 

0218 

RE:  AD  ( 8 ' NN  f ERR=500 ) ( ICODE  ( I ) f I 

=46 

0219 

N2=N1+1 

0220 

IF  (NOREC  .LE,  N2>  GOTC  250 

0222 

NN=NN+1 

0223 

READ ( 8 ' NN  t ERR=500 ) ( ICODE ( I > f 1=86 f 

125 

0224 

NN=NN+1 

0225 

250 

ICODE ( 45 ) = ICRLF 

0226 

ICODE ( 85 )= ICRLF 

0227 

ICODE (125)=ICRLF 

0228 

ICODE ( 1 26  > = I DC1 

0229 

IF  (J  .EO.NURTS)  ICODE ( 1 -26 > =LHOME 

0231 

CALL  URLOOF(IIST) 

0232 

I1ST=1 

0233 

310 

CONTINUE 

0234 

710 

IF  ( ICFLG  .EQ.  0)  GOTO  330 

0236 

DO  510  J=1f12G 

0237 

510 

ICODE ( J ) = ICON ( J > 

0238 

CALL  URL  OOP < 1 1ST) 

0239 

ICFLG--0 

0240 

330 

IF  (NOREC  .EQ.  0)  GOTO  25 

c 

WRITE  OUT  SCREEN 

0242 

DO  70  J=1.N0REC 

0243 

N0R=NRCN0+ J- 1 

0244 

READ ( 8 ' NOR ) ( MOUT (IfJ)fI=1f10) 

0245 

70 

UR I TE ( 1 . 1 5 ) ( MOUT ( IfJ)fI=1f10) 

0246 

DO  80  J=1f11 

0247 

DO  80  I=1f10 

0248 

80 

MOUT(If J)=0 

0249 

GOTO  25 

0250 

500 

CONTINUE 

0251 

END 

-FEDERAL  AND  SPECIAL  SYSTEMS  GROUP 
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MOUT(l,  1)  = 
'MSGaTOaC 


Figure  1-10.  PI  000 


Read  record 
.1  + 13  of 
MSG.  DAT  into 
MOUT  (I.  J).  J 
I * 1.  10  / 


Write 

MOUT  (I.  J). 

I = 1,  10 
to  record  J+33 
of  MSG.  DAT 


NRCNO  = 34 
.\OREC  = 6 
ICON(3)  = 
IHC4 


;t(ind,  2) 


STdND.  2) 

= 9 


'STdND,  2) 


STdN'D,  2) 


ICON  (3) 
IHC  4 


r» 

t 

ICOM1)  = 0 

ICOM2)  = 0 

ICFLG  = 1 

ICON  (4)  = I. HOME 
STdN'D,  1)  * 1004 
ICOM127)  ; LEOP 

FEDERAL  AND  SPECIAL  SYSTEMS  GROUP 


FORTRAN  IU  U01B-02  TUE  01-MAR-77  15:52127  FAGE  001 

C0RE=08K.  UIC=C20 r 203  F1000 . 0BJ=P1 000 . FOR/NOSN/L I J 1 

C 

0001  SUBROUTINE  P1000 
C 

C CRT  TO  CRT  MODE  OF  OPERATION 

0002  REAL*8  M0UT.SK8.H8EpNDI pLIBpTAB.NWD 

0003  INTEGER  ST 

0004  COMMON  NBI » L IB r TAB p NUB p ST ( 3 » 9 ) , IND 

0005  COMMON  /UOOO/  MOUT (10.11),  NRCNO » NOREC 

0006  COMMON  /LOOP/  ICODE ( 120 > » MSK » LSK 

0007  COMMON  /CF'AC/ ICON  ( 1 20  > p ICFLG 

0008  BATA  IHC4.IHC8/' 2404. *2410/ 

0009  REAL*8  H34  r H38  pH39 

0010  REAL*S  L I BPAIR » Ml > M2 

0011  BATA  H38pH34pSK8pH0E/,8  'p'4  '»'  '.'ENTER  NB'/ 

0012  BATA  Ml p M2/ ' MSG  TO  C'p'RT  ND=  V 

0013  DATA  ISPCpLF.LH0ME»LE0P/*20040. *12. *24. *177777/ 

0014  BATA  IHC9.H39/*2411. '9  '/ 

0015  IF  (ST(INBpI)  .EQ.1000)  GOTO  14 

0017  IF  (ST(INBpI)  .EO. 1003)G0T0  53 

0019  IF  (ST(INB.l)  p EO . 1 004 ) GOT 0 54 

0021  53  BO  500  J=5p20 

0022  ICON ( J)=LF 

0023  500  IF  (IND  .EQ.  3)  IC0N(J)=0 

0025  BO  510  J=4  , I 08 

0026  ICON ( J+17 ) =ICOBE ( J ) 

0027  ILM= I AND ( MSK . I CODE ( J ) > 

0028  ILL=I AND 'LSK . ICODE( J > ) 

0029  KK=J+17 

0030  IF  (ILM  .EQ.  MSK)  GOTO  520 

0032  510  IF  (ILL  .EQ.  LSK ) GOTO  530 

0034  520  ICON ( KK) =IAND(LSK . I CODE ( KN-1 7 ) > 

0035  GOTO  540 

0036  530  ICON ( KK )=0 

0037  540  BO  550  J=KK+1p125 

0038  550  IC0N(J)=0 

0039  M0UT(1.1)=M1 

0040  MOUT (2.1) =M2 

0041  MOUT ( 3 p 1 ) =H38 

0042  IF  (ST( INBp 2)  .EQ.  4)  MOUT ( 3 . 1 ) =H34 

0044  IF  ( ST ( IND. 2)  .EQ.  9)  MOUT ( 3 p 1 > =H39 

0046  DO  20  1-4  p 10 

0047  20  MOUT ( I . 1 ) =0 

0048  DO  300  J=2.6 

0049  300  READ (S'J+13) ( MOUT (I.J).I=1.10) 

0050  BO  400  J=1 p 6 

0051  400  WRITE (8 ' J+33 ) ( MOUT (I. J). 1=1.10) 

0052  NRCN0=34 

0053  N0REC=6 

0054  ICON ( 3 ) =IHC4 

0055  IF  ( ST ( IND, 2)  .EQ.  8)  IC0N(3)=IHC8 

0057  IF  < ST ( I NB  p 2 ) .EQ.  9)  IC0N(3)  = IHC9 

0059  ICON ( 1 ) -0 

0060  ICON ( 2 ) =0 

0061  I CON (4 )-LHOME 

0062  IF  (IND  .EQ.  3)  IC0N(4)=LF 

0064  ICON  (126)  =L.HOME 
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FORTRAN 

IV 

V01B-02  TUE  01 -MAR- 

C0RE= 

08K 

. UIC=E20,203  1 

0065 

IC0N( 127)=L£0P 

0066 

ICFLG=1 

0067 

ST ( IND. 1 >=1004 

0068 

RETURN 

0069 

54 

1=1 AND ( LSK  > I CODE ( 4 ) ) 

0070 

1=1-48 

0071 

IF  (I  .EQ.  1)  GOTO  700 

0073 

IF  <1  .EQ.  2)  GOTO  1 

0075 

IF  (I  .EQ.  3)  GOTO  8 

0077 

IF  (I  .EQ.  4)  GOTO  6 

0079 

19 

NRCN0=1 1 

0080 

N0REC=1 

0081 

RETURN 

0082 

700 

NRCNO=l 4 

0083 

N0REC=1 

0084 

ST  < IND. 1 > = 1003 

0085 

RETURN 

0086 

1 

NRCN0=12 

0087 

N0REC=2 

0088 

ST  < IND. 1 > = 1000 

0089 

RETURN 

0090 

8 

NRCN0=21 

0091 

N0REC=1 

0092 

3T ( IND  > 1 ) =9999 

0093 

RETURN 

0094 

6 

NRCN0=5 

0095 

N0REC=6 

0096 

ST< IND. 1 >=0004 

0097 

RETURN 

C 

NODE  DESIG  OF  DEST  CRT 

0098 

14 

ST < IND » 2 ) = 1 AND < LSK'.  IC0DEC4) > 

0099 

ST ( IND  »2)=ST(IND»2>-48 

0100 

IF  < ST < IND . 2 ) .EQ.  30)  GOTO  30 

c 

ELSE  DO 

c 

CK  FOR  INVALID  NODE  DESIGNATOR 

0102 

IF  ( ST  < IND » 2 ) . EQ . 4 ) GOTO  7 

0104 

IF  < ST  < IND . 2 ) .EQ.  8)  GOTO  7 

0106 

IF  (ST < IND. 2)  .EQ.  9)  GOTO  7 

c 

ELSE  INVALID  NODE  DESIGNATOR 

0108 

17 

NRCNO= 1 1 

0109 

N0REC=3 

0110 

ST  < IND . 1 ) = 1000 

0111 

RETURN 

c 

REQ  ENTER  MESS  - MS121 

0112 

7 

NRCN0=14 

0113 

N0REC=1 

0114 

ST  < IND. 1 > = 1003 

0115 

RETURN 

0116 

30 

CONTINUE 

0117 

DO  100  J=1.U 

0118 

100 

READ(7'J)(M0UT(IrJ>. 1=1.10) 

0119 

DO  40  1=1.10 

0120 

40 

MOUT (1.11) =SKG 

0121 

MOUT (1.11) =H8E 

0122 

DO  50  J=lrll 

0123 

50 

URI TE ( 8 ' J+33 ) ( MOUT (I.J).I=1.10> 

77  15J52J27  PAGE  002 

PI 000 • 0BJ=P 1000 . F0R/N0SN/LI 1 1 


M 
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FORTRAN  IV  V01B-02  TUE  01-MAR-77  15:52:27  PAGE  003 

CORE=08K  r UIC-C20r203  PI 000 . OB J-P1000 . FOR/NOSN/L I .*  1 

0124  NRCN0=34 

0125  N0RCC=1 1 

0126  ST  < INDr 1 > = 1000 

0127  RETURN 

0128  END 


FORTRAN  IV  DIAGNOSTICS 

C WARNING  3 MSG  #092  VARIABLE  "LIDPAI*  NAME  EXCEFDS  6 CHARACTERS 

C WARNING  3 MSG  *094  NON-STANDARD  STATEMENT  ORDERING 

FOR  — CP1000  3 ERRORS:  Or  WARNINGS!  2 


> 


Burroughs  Corporation 


FORTRAN 
COPE -OS I 

c 

00  0 1 

c 

c 

0002 

0002 

0004 

0005 

0006 
000? 

000  s 

0009 

0010 
0011 
0012 

0013 

0014 

0015 
0017 

0019 
0021 
0022 
0023 

0025 

0026 
002? 

0020 
0029 
0020 
0022 
0034 

0025 

0026 

0027 

0028 
0029 
004  0 
0041 
004  2 
004  4 
004  6 
004  7 
00  4 S 
004  9 

0050 

0051 

0052 
0052 

0054 

0055 
0057 

0059 

0060 
0061 
0062 
0064 


IV  V 010-02 

, UK  =C  20,  20  1 


FRI  18-MAP-77  19  01:25 

P10001  C6J-P10001  FOR/ 


SUBROUTINE  PI 000 

CRT  TO  CRT  MODE  OF  OPERATION 
REAL’S  MOOT,  SkS,  HSE  ■ NO  I,  Lit*.  TAB,  NWD 
INTEGER  ST 

COMMON  NBI,  LIB,  TAB,  MHO,  ST<3,  97,  INC* 

C 0 M M 0 N 2 U 0 0 0 / M 0 U T ( 1 0 . 1 1 7 , N R C NO.  N 0 PEC 
COMMON  /LOOP/  I C OC*E  < 128  * , MSK  • LSn 
C 0 M M 0 N / CPA C / 1 C 0 N ( 1 2 8 7 , I C F L 0 
DATA  I H C 4 ■ IHC8.  "404,  "410/ 

REAL  + 8 H24.H2S  ,H29 
REAL'S  LIDPAIR. Ml, M2 

DATA  H28,  H34,  SKS,  H S'  £ / ' 8 ' . • 4 ' , ' 

BATA  Mi,  M2."  MSG  TO  C','RT  N B = '/ 

BATA  ISPC, LF, LHOME, LEOP/ " 2004 0, "12, "24, “177???/ 
DATA  I H C 9 , H 2 9 “ 4 1 1 , 9 / 

IF  CSTclNP, 1*  EO  1000 > GOTO  14 
IF  <ST(IND,  1.*  . EO.  1003, ‘GOTO  53 
IF  (STCI'nD,  1*  EO  1084  'GOTO  54 
52  00  500  ...1  = 5,  20 
ICON'.  J.'  = LF 

500  IF  (INC*  EO  27  ICON  '.  J 7 = 0 

00  510  J=4, 108 
ICONCJ  + l?  7*IC0DE‘  J> 

1 LM=  I AND  (.  MSK,  I C ODE'.  J 7 > 

I LL=  I AND  C LSK,  ICOOE  < J .»  * 

K K = J + 1 7 

IF  < I Ll'1  . EO.  MSK*  GOTO  520 
510  IF  (.ILL  EQ  LSK > GOTO  520 
520  ICONCKK  ' = I AND  (LSK,  I CODE  ( KK -1  ;■ 

GOTO  540 
530  I CON  ' K K > = 0 
540  BO  550  J=KK+1, 125 
550  ICON(.J  '=0 

MOUTtl, 17=M1 
MOOT (2, 1 7 = M2 
MOUT  ( 2,  1 ,'  = H 3 8 

IF  < S T ( I NB,  2 7 EO  4,’  MOU  T C 2,  1 =H24 

IF  (ST  ( I N B , 2 7 EO.  9,’  M 0 U T ( 3 , 1 ;■  = A 3 9 

BO  20  1=4,10 
20  MOUT <1,17=0 
BO  300  0=2, 6 

200  READ'S' 0 + 12  7 (MOOT C I, J),  1 = 1, 107 
BO  400  ..1  = 1,  6 

400  WRITE'S' J + 33  7 (MOUT < I, J7,  1=1,  107 
NPCN0=S4 
N0PEC=6 
I CON  < 2 7 = I HC4 

IF  ( S T < IN B , 2 7 EO  87  I CONc 37  = IHC'0 

IF  ( S T < I N D . 2 7 EO.  9 7 I CON ( 3 7 = I HC9 

ICONcl 7=0 
ICON C 2 '=0 
ICON'. 4 >=LHOME 

IF  tINB  . EO.  27  IC0N'.4  7 = lF 
'I  CON  ( 126  7 = LHOME 


PAGE  001 
NOSM/LI  1 
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IV- 

. — FEDERAL  AND  SPECIAL  SYSTEMS  GROUP 


FORTRAN 

IV 

V 018-02  FRI  18-MAR-??  1?  01  25  RAGE  002 

COPE  = 

08  K 

, U I C = C 2 0 , 2 0 J P10001  08..I-E  10001-  FOR/NOSN/L I . 1 

00 1'5 

ICON'  1 2 7 ’ = L E 0 P 

0 0 E E 

ICFLG=1 

0 0 6 7 

ST  < I NO..  1 7=1004 

0 0 6 0 

RETURN 

0 0 r.  $ 

54 

I = I ANDlLSK  • I CODE  < 4 • 

0070 

1=1-48 

00  71 

IF  '.I  E 0 . 1 ■ GOTO  7 0 0 

0 0 7 s 

IF  (I  EO  2,'  GOTO  1 

0 0 7 j 

IF  L I E 0 3 > G 0 T 0 3 

007? 

IF  LI  EQ  4'  GOTO  €■ 

0079 

19 

NRCN0=11 

0080 

N 0 P E C = 1 

0081 

R E T U F N 

0082 

7 O 0 

N R C N 0 = 1 4 

0082 

N 0 R E C = 1 

0084 

ST  L IND, 1 > = 1002 

0085 

RETURN 

0088 

1 

N g C N 0 = 1 2 

008  7 

N 0 R E C = 2 

O088 

STL IND,  1>  = 1000 

0089 

RETURN 

0090 

8 

N R C N 0 = 2 1 

0091 

N 0 R E C = 1 

0092 

STL  IND,  1 >=9999 

0092 

RETURN 

0094 

6 

N R C N 0 = 5 

0095 

MORE 0=8 

0O9  £ 

ST L IND  ■ 1 2 = 0804 

0097 

RETURN 

C 

NODE  DESIG  OF  DFST  CRT 

0098 

14 

ST L IND,  2 > = IRHDCLSK  • I C ODE  L 4 7 ;• 

0099 

ST < IND,  2 >=ST<.  IND,  2 7-48 

0100 

IF  (STL IND, 2 7 ED  SO 7 GOTO  30 

c 

ELSE  DO 

c 

CK  FOR  INVALID  NODE  DESIGNATOR 

0102 

IF  < S T L I N D • 2 7 EO.  47  GOTO  7 

0104 

IF  (STLIND, 27  . EO.  87  GOTO  7 

0108 

IF  (STLIND,  27  . EQ.  9 7 GOTO  7 

c 

ELSE  INVALID  NODE  DESIGNATOR 

0108 

17 

NRCN0=11 

0109 

N 0 R £ C = 2 

0110 

STLIND, 1 ’=1000 

0111 

RETURN 

c 

REG  ENTER  MESS  - MS121 

0112 

7 

NRCN0=14 

0112 

N0R£C=1 

0114 

ST  L INC1,  1 7 = 1003 

0115 

RETURN 

0118 

20 

CONTINUE 

0117 

DO  100  J=l, 11 

0118 

1 0 0 

READ':.?'  J7  ■ MOOT',  I , J,’,  1 = 1,  10  » 

0119 

DO  40  1=1,10 

0120 

40 

MOOT < I, 11 7 = Sk3 

0121 

MOUTlI  11 7 =H8E 

0122 

DO  50  J=l,ll 

0122 

50 

WRITE L 8 ' J + 22  ■'  L MOOT (.  I , J7,  1=1.  107 
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FORTRAN  IV  V01B-02  FRI  18-MAR-??  19-01:25  F-AGE  «‘.C 

CORE*08K/  U I C = C 20.  20  I P1OO01.  Ofc:J=P10001  FOP/NGSN.-'Ll  1 

0124  HRCN0=34 

8125  NOREC=ll 

8126  STCIND,  1 ' = 1888 

812?  RETURN 

8128  END 


FORTRAN  IV  DIAGNOSTICS 

I WARNING  I MSG  #092  VARIABLE  "LIDPAI"  NAME  EMC  EEC'S  6 CHARACTERS 

C WARNING  I MSG  #894  NON-STANDARD  STATEMENT  ORDERING 


FOR 


CP1000  I ERRORS:  0,  WARNINGS  2 


FEDERAL  AND  SPECIAL  SYSTEMS  GROUP 


1 

K 


P2000 


Figure  1-11.  P2000 
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P2000  (cont.) 


RETURI 


\\  rite 


NRCNO  =45 
NOREC  = 6 
ST(IND.  1)  = 2004 


ND  = IAND 
(LSK.  ICODE(4)) 
ND  = ND-48 


MOUT  to 
record  J * 44 
of 


ST(IND,  3) 


Read  record 
NR  of 

INFO.  DAT 
into  MOUT 


NRCNO  = 51 
NOREC  = 8 
STUND,  1)  = 2004 


RETURN 


R<ad  record 
NR  of 

INFO.  DAT 
into  MOUT 


W rite 
MOUT  to 
record 
•T  ♦ 58  of 


NRCNO  = 59 
NOREC  « 11 
ST  (INI).  1)  2004 


RETURN 


I Read 

record  / 

/ NR  of 

/ 

INFO. 

DAT  / 

/ into  MOUT  / 

/ (K..T), 

K = 1,  10  / 

NR  = (JJ  - 1 ) 

* 11  * 275  + .1 

.1 

/ 

L 



/ Write  record  / 

.1  * 50  of  / 

n 

MSG.  DAT  / 
into  MOUT  / 

I 


FORTRAN  IV  V01B-02 

CORE=08K  , UIC=C20f20I 


-FEDERAL  AND  SPECIAL  SYSTEMS  GROUP 


TUE  01  -MAR-77  16:02102  P^E/t 

P2000 • OB J=P2000 . FOR/NOSN/L I . 1 


C SYSTEM  INQUIRY  MODE  OF  OPERATION 

C 


0001 

SUBROUTINE  P2000 

0002 

REAL*8  NDI.LID.TAB.NWD 

0003 

REAL*8  MOUT.CRTINMSG 

0004 

INTEGER  ST 

0005 

COMMON  NDI ,LID,TAB,NUD,  ST (3,9) • 

0006 

COMMON  /DSK/I 1 , 12, 13. 14.15.16,116 

0007 

COMMON  /U 000/  MOUT( 10, 1 1 ) .NRCNO.NOREC 

0008 

COMMON  /LOOP/  I CODE (128). MSK , LSK 

0009 

IF  (STdND, 1)  .EQ.  2000)  GOTO  39 

0011 

IF  (ST(IND.l)  ,EQ.  2003)  GOTO  53 

0013 

IF  (STdND,  1 ) .EQ.  2004)  GOTO  54 

0015 

IF  (ST (IND , 1 ) .EQ.  2005)  GOTO  55 

0017 

53 

NP=IAND(LSK,IC0DE(4> ) 

0018 

ND=ND-48 

0019 

IF  (ND  .EQ.  30)  GOTO  72 

0021 

JJ=ND 

0022 

IF  <ND  .GE.  10)  GOTO  20 

0024 

NP=I AND ( MSN , I CODE  < 4 ) ) 

0025 

ND=ISHFT ( ND , -8 ) 

0026 

ND=ND-48 

0027 

IF  (ND  .EQ.  0)  JJ=10 

0029 

IF  (ND  .EQ.  1)  JJ=11 

0031 

GOTO  22 

0032 

20 

NRCN0=1 1 

0033 

N0REC=1 

0034 

RETURN 

0035 

22 

CONTINUE 

0036 

GOTO  (72,51,52,530)  STdND, 3) 

0037 

51 

DO  110  J=l,6 

0038 

NR=(JJ-1)*6+121+J 

0039 

110 

READ ( 7 ' NR ) ( MOUT ( N , J ) »K=1 . 10) 

0040 

DO  44  J=l,6 

0041 

44 

WRITE (8'J+44»  ERR=20  > ( MOUT ( K , J ) ,K=1 , 10 

0042 

NRCN0=45 

0043 

N0REC=6 

0044 

ST ( IND, 1) =2004 

0045 

RETURN 

0046 

52 

DO  120  J=1 , 8 

0047 

NR= ( JJ-1 ) *8+187+ J 

0048 

120 

READ ( 7 ' NR  > ( MOUT ( K » J ) » K=1 , 10  > 

0049 

DO  45  J=1 , 8 

0050 

45 

WRITE ( 8 ' J E50 , ERR=20 ) ( MOUT ( K , J > . K=1 ,10 

0051 

NRCN0=51 

0052 

N0REC=8 

0053 

ST(IND. 1)=2004 

0054 

RETURN 

0055 

530 

DO  130  J=l,ll 

0056 

NR= ( JJ-1 >*1 1 +275+J 

0057 

READ (7 'NR) (MOUT(N, J) ,K=1 , 10) 

0058 

130 

WRI TE(8 ' J+58) (MOUT (K. J) ,K=1.10> 

0059 

NRCN0=59 

0060 

NOREC= 1 1 

0061 

STdND, 1>  = 2004 

0062 

RETURN 
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CORE=08K r UIC=C20 » 201  P2000 . 0D J=P2000 . F0R/N0SN/L I ! 1 


0063 

54 

NRCN0=30 

0064 

N0REC=4 

0065 

STUNBr  1 >=2005 

0066 

RETURN 

0067 

55 

1 = 1 ANIKLSN  f ICOBE  < 4 ) ) 

0068 

1=1-48 

0069 

IF  <1  ,E0.  1)  GOTO  2 

0071 

IF  (I  .Ed.  2)  GOTO  8 

0073 

IF  <1  .EG.  3)  GOTO  6 

0075 

NRCN0=1 1 

0076 

NOREC=l 

0077 

RETURN 

0078 

2 

NRCN0=22 

0079 

N0REC=5 

0080 

ST(IND,1>=2000 

0081 

RETURN 

0082 

8 

NRCN0=21 

0083 

N0REC=1 

0084 

ST  < INDp 1 ) =9999 

0085 

RETURN 

0086 

6 

NRCN0=5 

0087 

N0REC=6 

0088 

ST ( INDr 1 ) =0004 

0089  • 

RETURN 

C 

GET  INFOTYPE 

0090 

39 

I = IAND  < LSK  > ICODE  < 4 ) > 

0091 

1=1-48 

0092 

IF  (I.LE.O)  GOTO  71 

0094 

IF  (I  .GE.  5)  GOTO  71 

0096 

IF  < I . EG • 1)  GOTO  72 

0098 

ST(IND»3)=I 

0099 

25 

NRCN0=27 

0100 

N0REC=3 

0101 

ST ( INDr 1 )=2003 

0102 

RETURN 

0103 

72 

DO  100  J=l»ll 

0104 

100 

REAB< 7' J) < MOUT (K»J)»K=1»10) 

0105 

DO  43  J=l»ll 

0106 

43 

WRITE  <8'J+33><  MOUT  <K»J)fK=l»10) 

0107 

NRCN0=34 

0108 

N0REC=1 1 

0109 

ST( INDf 1 >=2004 

0110 

RETURN 

0111 

71 

NRCN0= 1 1 

0112 

N0REC=1 

0113 

RETURN 

0114 

END 

FORTRAN 

IV 

DIAGNOSTICS 

C WARNING  I 

MSG  *092  VARIABLE  "CRTINM*  NAME  EXCEEDS  6 CHARACTERS 

FOR  — 

CP2000  i errors:  o.  warnings:  i 
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I 


•federal  and  special  systems  group 


P3000 


(start) 


STdND,  5)  = 

IAND  (LSK,  ICODE(4)) 
STdND,  5>  * 

ST(IND,  5)  - 48 


NRCNO  * 76 

i /ST(IND.  1)  ^ 

9K99 

Ol 

NOREC  = 2 

STdND.  1)  = 3001 

—(return) 


STdND,  4)  = 10 

■ 

r 

■ 

No 

Figure  1-12.  P3000 
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-FEDERAL  AND  SPECIAL  SYSTEMS  GROUP 


P3000(cont.) 


2 


INVH  = IAND  (MSK,  ICODF(4)) 
IN VH  = ISHFT  (INVH,  -8) 
INVH  = INVH  -48 


INVT  = IAND  (LSK,  ICODE(5)) 
INVT  = INVT  -48 


IN  VO  = IAND  (MSK,  ICODE(5» 
INVO  = ISHFT(INVO,  -8) 

IN  VO  = INVO  -48 


ICON (4)  = 100*  INVH + 10*  INVT 
+ INVO 


Figure  1-12.  (Cont.) 


25 


■FEDERAL  AND  SPECAL  SYSTEMS  GROUP 


P3000  (cont.) 


RLNE(KK)  = RI.IDC 


Write  RLNE 
into  record  NR 
of  INFO.  DAT 


ICON  (4)  = IFAD  + ICON(4) 
ICON(3)  - ISHFT  (5,  8)+ST(IND,  4) 
ICON(2 ) = 16 
ICON(5)  = "177777 
ICON(l)  - "125125 


ICFLG  = 1 
NRCNO  = 104 
NOR EC « 5 
ST(IND,  1)  = 3012 


J = 1#  16 

NR  = (STUNT),  4) 

-1)  * 6 * 121  + 

/ Read  record  NR  / 

/ of  INFO.  DAT  / 

/ into  MOUT  / 

/ Write  MOL'T  into  / 

/ record  44  + J of  / 

/ MSG.  DAT  / 

NRCNO 

NORFC 

ST(IND, 

= 45 
= 6 

1)  = 3005 

i 

RETURN) 


RETURN) 


Figure  1-12.  (Cont.) 
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FORTRAN  IV  V01B-02  FRI  18-MAR-77  19!04!40  PAGE  001 

C0RE=08N  , UIC=C20,20I1  P3000 . 0D J=P3000 . F0R/N0SN/L 1 1 1 

C SYSTEM  CONTROL  MODE  OF  OPERATION 
C 

0001  SUBROUTINE  F'3000 
C 

0002  REAL*8  NDI , LID. TAB . NUD 

0003  INTEGER  ST 

0004  REAL*8  MOUT , ND . N1 , N2 , N3 , N4 , N5 , N6 , N7 , NO . N9 . N10 , N1 1 . 

1 NEUV,CND,SK8.Z 

0005  REAL*4  RLIDC , RLNE » RSPC 

0006  COMMON  NDI , L ID , TAB , NUD , ST ( 3 , 9 ) , IND 

0007  COMMON  /DSK/1 1 . 12 , 1 3 f 1 4 , IS . 16 » 1 1 6 

0008  COMMON  /S230/  ND 

0009  COMMON  /U000/  MOUT < 1 0 , 1 1 ) , NRCNO , NOREC 

0010  COMMON  /LOOP/ 1 CODE ( 128 ) » MSK , LSK 

0011  COMMON  /CPAC/ICON (128)»ICFl_G 

0012  DIMENSION  ICHAR ( 4 > , L IDC ( 2 ) . RLNE ( 20 > 

0013  EQUIVALENCE  ( ICHAR, NEWV) 

0014  EQUIVALENCE  ( 1. 1 DC  > RLIDC ) 

0015  PATA  N1 »N2,N3,N4,N5,N6,N7.N8.N9,N10,N11 ,CND,SK8,Z/ 

l'l  '>'2  ' , '3  ' , ' 4 ' , 

2 '5  ' t '6  ' ,'7  ','B  ' t '9  ' . 

3 '10  '.'ll  ' > 8HCAN ' T DO,'  ','0  '/ 

0016  DATA  ISPC/’ 120240/ 

0017  DATA  IL'VA.LEOP/*  125125.  ’177777/ 

0018  DATA  RSPC  /'  '/ 


0019  20 

IF 

(ST ( IND, 1 ) 

.EQ. 

3000) 

GOTO 

3 

0021 

IF 

(ST(  IND,  1 '• 

.EC. 

30C 1 ) 

GOTO 

21 

0023 

IF 

( ST ( IND , 1 ) 

.EQ. 

3002) 

GOTO 

22 

0025 

IF 

( ST ( IND , 1 ) 

.EQ. 

3003) 

GOTO 

23 

0027 

IF 

(ST( IND » 1 ) 

• EQ. 

3004) 

GOTO 

24 

0029 

IF 

(ST(IND.l) 

• EQ. 

3005) 

GOTO 

25 

0031  CALL  P3001 

0032  RETURN 

0033  21  NJ=I AND ( LSK , I CODE ( 4 ) > 

0034  NJ=N J-48 

0035  IF  (NJ  .EQ.  30)  GOTO  102 

0037  ST  < I ND , 4 ) =NJ 

0038  IF  (NJ  .GE.  10)  GOTO  120 

0040  NJ=I AND ( MSN . I CODE ( 4 ) ) 

0041  NJ=ISHFT(NJ,-8) 

0042  NJ=N J-48 

0043  IF  (NJ  .EO.  0)  ST(IND,4>=10 

0045  IF  (NJ  .EQ.  1)  ST ( IND , 4 > =1 1 

0047  IF  ( ST ( IND , 4 ) .EG.  1)  ND-N1 

0049  IF  ( ST ( IND » 4 ) .EQ.  2)  ND=N2 

0051  IF  ( ST  ( IND , 4 ) .EG.  3)  ND=--N3 

0053  IF  ( ST ( IND » 4 ) .EQ.  4)  ND=N4 

0055  IF  ( ST ( I ND » 4 ) .EQ.  5)  ND=N5 

0057  IF  ( ST ( I ND , 4 ) .EQ.  6)  ND=N6 

0059  IF  ( ST ( I ND , 4 ) .EQ.  7)  ND=N7 

0061  IF  ( ST ( IND , 4 ) .EQ.  8)  ND-N8 

0063  IF  ( ST ( IND » 4 ) .EQ.  9)  ND-N9 

0065  IF  (ST ( IND , 4 > .EQ.  10)  ND=N10 

0067  IF  ( ST  ( IND , 4 > .EQ.  11)  ND--N11 

0069  GO  TO  122 

0070  120  NRCN0=1 1 
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C0RE=08K  t UIC=C20  > 203 


FRI  18-MAR-77  19!04M0  PAGE  002 

P3000 . OB J=P3000 . FOR/NOGN/L I ! 1 


0071 

N0REC=1 

0072 

RETURN 

0073 

122 

IF  ( ST ( IND > 5 > .EQ.  1)  GO  TO 

161 

0075 

IF  (ST ( IND » 5 > .FO.  2)  GO  TO 

165 

0077 

IF  ( ST ( I ND i 5 ) .EQ.  3)  GO  TO 

166 

0079 

IF  ( ST ( I NB  f 5 ) .EQ.  4)  GO  TO 

167 

0081 

102 

HO  110  J=l»ll 

0082 

RE AB ( 7 ' J ) ( MOUT  ( I , J ) , I = 1 , 1 0 ) 

0083 

110 

WRITE (8' J+33) <MOUT(I. J),I=1» 

10) 

0084 

NRCN0=34 

0085 

NOREC^l 1 

0086 

ST ( INH » 1 ) =3002 

0087 

RETURN 

0088 

161 

NRCN0=78 

0089 

N0REC=6 

0090 

ST  < IND  1 1 ) =3003 

0091 

RETURN 

0092 

165 

NRCN0=84 

0093 

N0REC=2 

0094 

ST ( I ND » 1 > -3004 

0095 

RETURN 

0096 

166 

NRCN0=86 

0097 

N0REC=3 

0098 

GT ( IND  r 1 ) =3006 

0099 

RETURN 

0100 

167 

NRCN0=89 

0101 

NOREC= 1 1 

0102 

ST(IND.1)“3008 

0103 

RETURN 

C 

NDI  RESPONSE 

C 

WAS  SUBROUTINE  3002 

0104 

22 

NRCN0=76 

0105 

NOREC-2 

0106 

ST ( IND » 1 ) =3001 

0107 

RETURN 

C 

NET  DEVICE  PARAMETERS 

C 

WAS  SUBROUTINE  3003 

0108 

23 

IPAR=I AND  < LSK 1 1 CODE ( 4 ) ) 

0109 

IFAR=IPAR-48 

0110 

ICODE ( 4 ) = I AND ( LSK  » I SPC ) + I AND ( MSK » I CODE  < 4 ) ) 

0111 

DO  600  J=1 r 4 

0112 

600 

ICHAR (J)=IC0DE(J+3) 

0113 

DO  200  J= 1 f 1 1 

0114 

200 

READ(7'J)  (MOUTdr  J)  ,1  = 1,10) 

0115 

IF  (IPAR  .EQ.  1)  GO  TO  250 

0117 

IF  (IPAR  .EQ.  2)  GO  TO  230 

0119 

IF  (IPAR  .EQ.  3)  GO  TO  230 

0121 

GO  TO  250 

0122 

230 

DO  260  I=2r8f3 

0123 

DO  260  L=5 » 8 

0124 

II  = I 

0125 

LL=L 

0126 

IF  (ND  .EQ.  MOUT ( I » L > ) GO  TO 

240 

0128 

260 

CONTINUE 

0129 

240 

IF  (IPAR  .EQ.  2)  III=II+1 

0131 

IF  (IPAR  .EQ.  3)  III=II+2 
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HOUT  ( 1 1 1 > t.L  ) =NEWV 
DO  241  J=1f11 

241  URITE(7,JHM0UT<IfJ)fI  = 1.10> 
ICFLG=1 
ICON ( 1 ) = ICVA 

ICON  < 3 ) =ISHFT  (5f8)+ST(  I Nil » 4 > 
ICON ( 2 ) =8 

INVH=IAND(MSKf IC0DE(4)  > 
INVH=ISHFT( INVHf-B) 

INVH=INVH -48 

IF  (INVH  .LT.  0)  INVH=0 

INVT=IAND(LSKfIC0DEC5>  > 

INVT=INVT- 48 

IF  ( INVT  .LT.  0)  INVT=0 

INV0=IAND(MSKf IC0DE(5>  > 

INV0=ISHFT(INV0f-8> 

INV0=INV0-48 

INV=100*INVH+10*INVT+INV0 
ICON  < 4 ) = INV 
ICON ( 5 ) =LEOP 

IF  (IPAR  .EQ.  2)  GOTO  247 
GO  TO  250 

247  DO  248  J=1f11 
NR=(ST(INDf4)-1 )*ll+275+J 
READ (7 'NR)  (MOUT <I»J)fI==1f10) 
MOUT ( 7 f 2 ) =NEUV 

248  WRITE < 7 ' NR > ( MOUT < I f J > f 1 = 1 f 10) 
ICON ( 2 ) =4 

ICON  < 4 ) = INV 
ICON ( 5 > =LEOP 
250  NRCN0=1 04 
N0REC=5 
DO  280  J= 1 f 1 1 
DO  280  1 = 1 f 10 
280  MOUT < I f J ) =SK8 
ST ( INDf 1 >=3012 
RETURN 
C LIDS 

24  DO  700  J=1 f 2 
700  LI  DC ( J ) = I CODE  < J+5 ) 

ILD=I  AND  ( L.SK  f I CODE  < 4 > ) 

IF  (ILD  .GT.  58)  GOTO  361 

INVH=IAND(MSKfIC0DE<4) ) 

INVH=ISHFT< INVHf-8) 

INVH=INVH--48 

IF  (INVH  .LT.  0)  INVH=0 

INVT=IAND(LSKfIC0DE(5> ) 

INVT=INVT-48 

IF  (INVT  .LT.  0)  INVT=0 

INVO=IAND(MSIs  f IC0DE(5>  ) 

INVO=ISHFT( INVOf-8) 

INV0  = INV0--48 

ICON(4)  = 10O*INVH+lO*INVTHNVO 
IF  ( ICON ( 4 ) .GT.  100)  GOTO  120 
IF  (IC0N(4>  .LT:  1)  GOTO  120 
JJ=2 
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0194 

IF  < ICON<  4 ) .GE.  21)  JJ=3 

0198 

IF  <IC0N<4>  .GE.  41)  JJ=4 

0200 

IF  < ICON<  4 ) .GE.  61)  JJ=5 

0202 

IF  (IC0N(4)  .GE.  81)  JJ=6 

0204 

INUH= I AND  < MSN f ICODE ( 6 > ) 

0205 

INUH=ISHFT(INUHf-8> 

0206 

INUH=INUH-48 

0207 

IF  < INUH  .LT.  0)  INUH=0 

0209 

I NUT = I AND (LSN>IC0DE(7) ) 

0210 

INUT=INUT-48 

0211 

IF  (INUT  .LT.  0)  INUT=0 

0213 

INUO=IAND(MSNf IC0DE(7> ) 

0214 

INUO=ISHFT( INU0.-8) 

0215 

INU0=INU0~48 

0216 

IFAD=1 00* INUH+ 1 0# INUT  + INUO 

0217 

IFAD=ISHFT< IFADfB) 

0218 

NR=  < ST  ( I ND  f4)~1)*6+121+JJ 

0219 

READ  ( 7 ' NR  r ERR- 1 20 ) ( RLNE  <1 ) f I = 1 , 20 ) 

0220 

DO  330  LL= 1 » 20 

0221 

330 

IF  (RLNE (LL ) * . EQ.  0)  RLNE ( LL )=RSPC 

0223 

KK=M0D(IC0N(4)f20> 

0224 

IF  <KK  .EQ.  0)  KK=20 

0226 

RLNE ( KK ) =RL I DC 

0227 

WRITE ( 7 ' NR  r ERR=120 ) ( RLNE (I)fI=1f  20 ) 

0228 

320 

ICON ( 4 ) =IFAD+ICON ( 4 ) 

0229 

ICON < 3 > = ISHFT ( 5 f8 )+ST ( IND » 4 ) 

0230 

ICON ( 2 ) =16 

0231 

I CON ( 5 ) =LEOP 

0232 

ICON ( 1 ) = ICUA 

0233 

ICFLG= 1 

0234 

NRCN0=104 

0235 

NOREC-5 

0236 

ST ( IND » 1 ) =3012 

0237 

RETURN 

0238 

361 

DO  362  J=1 f 6 

0239 

NR= ( ST ( IND  f 4 ) -1 ) *6+121+ J 

0240 

READ ( 7 ' NR  f ERR= 1 20 ) ( MOUT  < I f J ) , 1 = 1 f 10) 

0241 

362 

WRITE(8'44+J) (MOUT( If J) f 1=1 f 10) 

0242 

NRCN0=45 

0243 

NQREC=6 

0244 

ST ( IND  f 1 ) =3005 

0245 

RETURN 

C 

LID  RESPONSE 

C 

WAS  SUDROUTINE  3005 

0246 

25 

NRCNO=04 

0247 

N0REC=2 

0248 

ST  < IND  f1)=3004 

0249 

RETURN 

0250 

3 

ST ( INDfS ) = I AND(LSK f I CODE (4  > > 

0251 

ST ( IND  f5)=ST(INDf5)-48 

0252 

IF  <ST< IND f 5 ) . LE . 0)  GO  TO  120 

0254 

IF  <ST ( IND f 5 ) .GE.  5)  GO  TO  120 

0256 

ST  < IND  f 1 ) =300 1 

0257 

NRCNO=  76 

0258 

N0REC=2 

0259 

RETURN 
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P300I  (cont.) 


Read  record  NR 
of  file  INFO.  DAT 
into  MOl'T 


Write  MOL'T  into 
record  .1  ♦ 50  of 
file  MSG.  DAT 


NRCNO  = 51 
NOREC  = 8 
STGN'D,  1)  = 3007 


(return) 


(return) 


Figure  1-13.  (Cont.) 
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0001 

0002 

0003 

0004 

C 

0005 


SUBROUTINE  P3001 

REAL48  NDUPMDfNWDfMOUTfNIMfNDI fLIDfTABfNDfSKO 

REAL*4  RLIDCfRLNEfRSPC 

INTEGER  ST 

SUBS  3007  THRU  3012 

COMMON  NBI .LIDf  TAB  fNUB.ST (3.9) , INB 


0006 

0007 

0008 

0009 

0010 
0011 
0012 

0013 

0014 

0015 

0016 

0017 

0018 

0019 

0020 
0022 
0024 
0026 
0028 

0030 

0031 

0032 

0033 

0034 

0035 

0036 

0037 

0038 

0039 

0040 


C 


41 

27 


C 

28 

100 


COMMON  /DSK/  1 1 f 12 f 1 3 f 14 f 15 f 16 f 1 1 6 
COMMON  /S230/  NB 
COMMON  /S301/ITYP 

COMMON  /UOOO/  MOUTC IOf 1 1 > fNRCNOfNOREC 
COMMON  /L00P/IC0DEU28)  fMSKfLSK 
COMMON  /CPA C/  ICON< 128) fICFLG 
DIMENSION  I CHAR ( 4 ) f L IDC < 2 ) f RLNE < 20 > 
EQUIVALENCE  ( I CHAR f NDUPMD ) 

EQUIVALENCE  (LIDCfRLIDC) 

DATA  SKO/'  V 

DATA  NIM/'NOT  IMF'L  ' / 

DATA  ISPC/‘ 120240/ 

DATA  ICVA f LEOP/ ‘ 125125 f “177777/ 

DATA  RSPC  /'  '/ 

PICK  UP  WHERE  P3000  LEFT  OFF 


IF  (ST(INDfI) 
IF  (ST(INDfI) 
IF  <ST<INDf1) 
IF  (ST(INDfI) 
IF  (ST(IND.l) 
TAB  RESPONSE 


EQ.  3006)  GOTO  26 
EQ.  3007)  GO  TO  27 

EQ.  3008)  GO  TO  28 

EQ.  3010)  GO  TO  30 

EQ.  3012)  GO  TO  32 

WAS  SUBROUTINE  3007 


FORMAT ( A8 ) 

NRCNO- 86 
NOREC-3 

ST  < I ND  f 1 ) =3006 
RETURN 

WORKPAGE  PARAMETERS  - WAS  3000 


DO  100  J= 1 f 1 1 


NR=  < ST  ( I ND  f 4 ) - 1 ) * 1 1 +275+ J 
READ < 7' NR) ( MOUT ( T f J ) , 1 = 1 , 10) 
L=IAND<LSKf IC0DE(4) ) 


L=L-48 

IF  (L  .EQ.  30)  GOTO  75 


0042  IC0DE(4)  = IAND(LSKf ISPC > + I AND < MSK f IC0DE<4>  ) 

0043  DO  200  J=1f4 

0044  200  ICHAR ( J ) = ICODE ( J+3 ) 


0045 

0047 

0048 

0049 

0050 

0051 

0052 

0053 

0054 

0055 

0056 

0057 

0058 

0059 


IF  (L  .EQ.  1)  L=2 
L=L  + 1 

MOUT  ( 7 f L > = NRUF‘MD 
DO  110  J=1f11 
NR=  < ST  < IND  f 4 ) -1 ) *1 1 4 275+ J 
110  WRITE < 7 ' NR ) < MOUT ( I f J > f 1 = 1 f 10) 
DO  120  J= 1 f 1 1 
DO  120  I=1f10 
120  MOUT(If J)=SK8 
NRCNO= 1 04 
N0REC=5 

ST  < IND  f 1 > =3012 
RETURN 

75  DO  76  J=1  fU 
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0060  76  WRITE (S' J+5S  r ERR=999 ) ( M0UT (IfJ)fI=1f10) 

0061  NRCN0=59 

0062  N0REC=1 1 

0063  ST  < IND» 1 >=3010 

0064  RETURN 

C NWD  RESPONSE  - UAS  3010 

0065  30  NRCN0=89 

0066  N0REC=1 1 

0067  ST  < INDf 1 )=3008 

0068  RETURN 

C SYSTEM  CONTROL  NOBE  SWITCH  - UAS  3012 

0069  32  1 = 1 AND ( LSK  * ICOBE ( 4 > ) 

0070  1=1-48 

0071  IF  (I  .EQ.  1)  GO  TO  149 

0073  IF  (I  .EC),  2)  GO  TO  103 

0075  IF  <1  .EQ.  3)  GO  TO  108 

0077  IF  (I  .EQ.  4 > GO  TO  106 

0079  999  NRCN0=1 1 

0080  N0REC=1 

0081  RETURN 

0082  149  NRCN0=76 

0083  NOREC  = 2 

0084  ST  < I ND  > 1 ) =3001 

0085  RETURN 

0086  103  NRCN0=70 

0087  N0REC=6 

0088  ST ( IND f 1 ) =3000 

0089  RETURN 

0090  108  NRCN0=21 

0091  N0REC=1 

0092  ST ( IND, 1) =9999 

0093  RETURN 

0094  106  NRCN0=5 

0095  N0REC=6 

0096  ST< IND, 1 ) =0004 

0097  RETURN 

C LID/FAD  TABLE 

0098  26  DO  810  J=1f2 

0099  810  LIDCC J)=IC0DE<J+5> 

0100  ILD= I AND <LSKfIC0DE(4) ) 

0101  IF  (ILD  .GT.  58)  GOTO  472 

0103  INVH=IAND(MSK  > I CODE ( 4 > ) 

0104  INVH=ISHFT(INVHf-8> 

0105  INVH=INVH-48 

0106  IF  < INVH  .LT.  0)  INVH=0 

0108  INVT=IANDCLSKfIC0DE<5) > 

0109  INVT=INVT-48 

0110  IF  ( I NUT  .LT.  0)  INVT=0 

0112  INVO=I AND (MSK  f I CODE ( 5 ) > 

0113  INV0=ISHFT(INV0f-8) 

0114  INV0=INV0-48 

0115  IC0N<4)  = 100*INVH+10*INVT-f  INVO 

0116  IF  < ICON < 4 ) .GT.  254)  GOTO  999 

0118  IF  < ICON < 4 ) .LT.  101)  GOTO  999 

0120  JJ=J 

0121  IF  ( ICON < 4 ) .GE.  121)  JJ=2 


"3 


I 
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0123 

IF 

< ICON  < 4 ) 

.GE. 

141 ) 

J J=3 

0125 

IF 

( ICON ( 4 ) 

.GE. 

161 ) 

JJ=4 

0127 

IF 

( ICON ( 4 ) 

.GE. 

181 ) 

JJ=5 

0129 

IF 

( ICON ( 4 ) 

.GE. 

201  ) 

JJ=6 

0131 

IF 

<IC0N<4> 

.GE. 

221 ) 

JJ=7 

0133 

IF 

< ICON ( 4 ) 

.GE. 

241 ) 

J J=8 

0135  INVH=IAND(MSKfIC0DE<6>  ) 

0136  INVH=ISHFT ( INVHf-8) 

0137  INVH=INVH-48 

0138  IF  (INVH  .LT.  0)  INVH=0 

0140  INVT=IAND(LSK',IC0DE(7>  ) 

0141  INVT-INVT-48 

0142  IF  ( INVT  .LT.  0)  INVT=0 

0144  INVO=IAND(MSK, IC0DE<7> > 

0145  INVO= ISHFT ( IN VO  , -8 ) 

0146  INVO=INVO -48 

0147  IEAD=100*INVH+10*INVT+INVO 

0148  IF AD= ISHFT ( I FAD  > 8 ) 

0149  NR=  < ST  < IND , 4 > -1 > *8+ 1 87+ J J 

0150  READ  < 7 ' NR , ERR=999 ) ( RLNE ( I ) , 1 = 1 , 20  > 

0151  DO  430  LL=1f20 

0152  430  IF  (RLNE(LL)  .E0.  0)  RLNE ( LL ) =RSF'C 

0154  KK=MOD < I CON ( 4 ) f 20  > 

0155  IF  <KK  .EQ.  0)  KK'=20 

0157  RLNE ( KK ) =RL I DC 


0158 

0159 

0160 
0161 
0162 

0163 

0164 

0165 

0166 

0167 

0168 

0169 

0170 

0171 

0172 

0173 

0174 

0175 

0176 

0177 


URITE(7'NR,ERR=999) (RLNE(I) ,I=1f20> 
420  ICON(4)=IFAD+ICON(4) 

ICON  < 3 ) = ISHFT  <5f8)+ST(IND»4) 

ICON ( 2 ) =1 6 
ICON  ( 5 ) --LEOP 
ICON ( 1 ) =ICVA 
ICFl.G=l 
NRCN0=104 
N0REC=5 

ST  < INDf 1 >=3012 
RETURN 

472  DO  471  J=1 f 8 

NR=  ( ST  < IND  f 4 > - .1 ) *8+ 187+  J 
READ  < 7 'NR  f ERR -999 ) (MOUT  < I f J) ,1  = 1,10) 
471  URITE<8' J+50) (MOUT ( I , J) ,1=1,10) 
NRCN0=51 
N0REC=8 

ST ( IND  f 1 ) =3007 

RETURN 

END 


> 

***  MTO!  --  SELECT  ERROR 
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(start) 


P4000 


IFS  = LAND 
(LSK,  lCODE(4)) 
IFS  = IFS  - 48 


MOLT  (5.  7)  = 
KEYTYPKFM 
dFSI 


I FAC  (IND)  = 
IFS 


(return) 


READ  RECORD 
J + 129  OF 
MSG.  DAT 
INTO  MOCT  I 


'ST(IND,  l\  Yes  f 
= 4005  H R 


STdND,  1)\  Yes 
= 4006  / ^ 


NRC  NO  = 175 
NOR PC  = o 
STUND,  1)  = 4014 


RETURN) 


K = J * 178 
+ 3 *(IFS-1) 


READ  RECORD  j 
K OF 

MSG.  DAT  / 
INTO  MOUT  / 


WRITE  MOUT 
TO  RECORD 
J * 33 

OF  MSG.  DAT 


NRCNO  = 34 
NOREC  - 11 
ST(IND.  1)  = 4002 


fRETURN) 


/ READ  RECORD  / 

/ 136  OF  / 

^/^OCHA  RKFY^ 

MOUT(5,  6) 

V ^ : "2AAAAAAA 

/ MSG.  DAT  / 

/ INTO  MOUT  / 

^\(IFS)  = 2 / 

|No 

/nocharkeV^ 

„ Yes  1 MOfT(5.  61 

\^OFS>  * * s' 

READ  RECORD 
137  OF  I 

MSG.  DAT  / 
IN  TO  MOUT  / 


Figure  1-14.  P4000 
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wtissm 


!CON(l)  = ICON(l) 
+ ISHFT  (1.  8) 
ICON  (2)  = 0 
lCON<3)  -*  IH51 


:CON(4)  * 1 
ICON  (7)  = ICODE(3) 
ICON<8>  * 2 


ICON(5)  5 
ICON(H>  = ST(IND.  6) 
ICON (9)  = I EOP 


MOD(DEVST(4).  2) 


IRTN 

585 

- 
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C0RE=03k , U I C = C 20- 20  I 
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0001 


0002 

0002 

0004 

0005 

0006 
000? 
0003 

0009 

0010 


0022 

0024 

0025 

0026 
002? 


0028 
0040 
0042 
004  4 
004  6 
0048 
004  9 

0050 

0051 

0052 
0052 

0054 

0055 

0056 


SUBROUTINE  R4000 


FILE  ACCESS  MODE  OF  OPERATION 

REAL  * 3 MOUT,  020,  040,  KEYTYFEFM.'/MT,  OFIL. 

1 S T 1 , STD,  ADE,  UPC',  N D I , LID,  TAB,  HUD 

INTEGER  ST.  DI 
INTEGER  DE VS T ( 6 > 

COMMON  NDI,  LID,  TAB,  NWD ■ STc.'3,  IND 
DIMENSION  OF  I L <10,  2 > , DI  ' 100.' 

COMMON  /DSK/  II,  12,  12,  14,  15,  16,  116 
COMMON  /UOO0?  MOUT'.IO,  11.),  NPCNO,  NOREC 
COMMON  /MD04/NOCHAPKEY'  10.',  KEVTVPEF  M ( 1 0 ;■ 
COMMON  / F 0 1 / I FAC  t 2 ;■ 


0011 

COMMON  /LOOP/ 

ICOC'E 

<128  > , M 

SK,  LSK 

0012 

COMMOfl  /CP AC/ 

ICON' 123.'-  IC 

FlG 

0012 

COMMON  /Ml 710 

.DEVS 

T 

0014 

DATA  020, 040 

.’8H2 

8A4 

0815 

DATA  XMT, ST1, 

STD/ 

1' PRS  XMIT  . ' S 

T 

' , ■ S T 

DO  Y'/ 

0016 

DATA  NOCHAPKEV/2,  2 

, 2.  2,  4, 

2,  4,  2,  2,  2/ 

0017 

DATA  KEYTVPEFM/8H 

LET-C'IG 

, 8H  LET-DIG, 8 A LET 

lSHALPHANUM • 8H 

LET- 

D I G, 3H ALPHANUM, 

28HLET-DIG  , 8H 

LET- 

C1 1 G,  SH 

DIGIT/ 

0013 

DATA  ADE," 

ADDED 

• / 

0019 

DATA  UF'D/SH  UPDATED/ 

0026 

DATA  IH51, LEOP, KYM 

SK/" 2*401,  "177777,  "77577/ 

0021 

IF  ( S T < IND.  1.' 

. EO 

4000  :• 

GOTO  72 

0022 

IF  (STUND.  1) 

EO. 

4 0 0 2 > 

GOTO  22 

0025 

IF  (STUND,  1,' 

EO 

4003  > 

GOTO  22 

0027 

IF  '.STUND,  1> 

EO 

4004 

GOTO  24 

0029 

IF  (STUND,  1> 

EO. 

4005 

GOTO  25 

0021 

IF  (STUND,  1.) 

EO. 

4 u o 6 ;• 

GOTO  26 

CALL  P4001 
RETURN 

MODT  VP=  I AND'  LSt  , ICOD£<  4 ) J 
M 0 D T V P = M 0 D T V P - 4 8 
IFS=  IFACv  IND.' 

PD  TYPE  OF  MOD 

NO  MODIFICATION  - ACCESS  ONLY 
CK  FOR  CROSS-REFERENCING 


EO 


IF 

IF 


EO 


IF  < MODT VP 
IF  < I FS  EO 
IF  U FS  EO 
U FS  EO 
( MODT VP 
GOTO  ?2 
273  N R C N 0 = 1 4 O 
NOPE  C = 6 

ST(  IND,  1 ) = 4003 
PE  TURN 
N R C N 0 = 1 4 7 
N0REC=9 

ST' IND. 1 =4004 
RETURN 


1)  GOTO  260 
2 ) G 0 TO  273 
2,>  GOTO  278 
4,'  GOTO  2 79 
2.'  GOTO  262 


279 
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CORE* 

03k,  U I C =1  20, 20)  P4000 

005? 

260 

NRCN0=15? 

0053 

N0REC=1 

0059 

ST  UNO,  17  = 4003 

OOc'O 

RETURN 

0031 

263 

NRCH0=156 

0032 

STC INO.  17=4005 

0033 

NOREC= 1 

0034 

RETURN 

0035 

23 

ST  UNO.  8 7= I AND  ( LSK,  I CODE  C 4 7 7 

0036 

STCINO, 8 7 = S T < I HO, 87-48 

C 

RERO  CROSS-REF  1 

003? 

NRCN0=153 

0063 

N0REC=1 

O039 

S T < I NO, 17=4005 

00?O 

RETURN 

0071 

24 

ST(  INO, 9 7 = 1 RNO  < LSK,  IC0DEC477 

0072 

ST  C 1 NU,  9 7 = S T C I N 0 , 97-48 

C 

RO  C-R  2 

0073 

HRCN0=156 

0074 

N 0 R E C = 1 

0075 

STCINO, 17  = 4005 

0073 

RETURN 

007? 

25 

ST C I NO, 3 7 = I AND C KVMSK,  I CODEC 4 7 7 

00  73 

T FS= I FflC ( I NO  7 

C 

GET  ST  Cl  NO, 8 7 

0079 

RERDC2'  I FS, ERR  = 73>  COI C I 7,  1 = 1,100  7 

00SO 

DO  550  K = 1 , 100 

0031 

STC INO, 77=K 

0082 

IF  C0ICK7  EQ  07  GOTO  585 

0034 

IF  (STC INO, 6 7 EO.  DICK 7 7 GOTO  560 

0036 

IF  ( ST C I NO, 6 7 EQ  -OICK77  GOTO  800 

0083 

550 

CONTINUE 

C 

KEY  EXISTS 

0OS9 

530 

LU  = IFS-*  2 

0090 

REflOCLU' ST C INO, 77, ERR  = 73 7 C C OF  I L C I , 27 

0091 

00  532  2=1,  3 

0092 

00  532  1=1,10 

0093 

532 

ITOUTC  I . J >*OFIL(  I,  2 7 

0094 

IF  ( I FS  EQ.  27  GOTO  570 

0093 

IF  CIFS  . EQ  37  GOTO  570 

0098 

IF  CIFS  EQ  47  GOTO  580 

c 

ELSE  NO  C-R 

0100 

M0UTC1, 57=XHT 

0101 

DO  5100  2 = 1,  5 

0102 

5100 

IT  RITE  C 8 J + 33  7 C MOUT  C 1 , 27,  1=1,  107 

0103 

N R C N 0 = 3 4 

0104 

N 0 R E C = 5 

0105 

STC INO,  17=4008 

0103 

RETURN 

010? 

• 3 0 0 

ICON  Cl  7 = ICON  Cl  •♦ISHFTcl,  87 

0103 

IC0Nc27=0 

0109 

IC0Nc2>=IH51 

0110 

ICON' 47=1 

0111 

I C 0 N C 5 7 = I F S + 2 

0112 

I C 0 N c 6 7 = S T ' INO,  67 

0113 

ICON C 7 7= I CODE • 37 

PAGE  002 
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C0RE  = 

03K,  U I C = ( 2 0 , 201 

0114 

ICON <8, '=2 

6115 

I CON ( 9 7 =LE0P 

0116 

I RTN=  700 

6117 

GOTO  710 

0118 

700 

IF  < I FS  . EO  27  GOTO  570 

0120 

IF  (IFS  . EO  37  GOTO  576 

6122 

IF  < IFS  EG  47  GOTO  580 

0124 

NOREC=0 

0125 

ST(  IND,  17  = 4006 

0126 

RETURN 

C 

RECORD  NOT  EXIST (NK7 

6127 

565 

NRCNu=210 

0128 

N0REC=1 

6129 

ST(IND,  17=4006 

0120 

RETURN 

C 

C-R  I FS=04 

0121 

576 

IF  (STUNG,  87  EO  27  GOT 

0123 

T1=SECNDS(0  7 

0134 

1000 

DELTfi=SECNDS(T17 

0125 

IF  < DEL  TP  GE  17  GOTO  64 

0137 

GOTO  1000 

C 

ELSE  L0C9TE  RECORD 

0138 

648 

REftD(2'  4,  E R R = 7 3 7 ( 0 1 ( 1 7,1 

8139 

L'O  571  L=l,  100 

0140 

LL  = L 

0141 

IF  (DKL7  . EO  07  GOTO  5? 

0143 

IF  (ST ( IND, 67  EG.  DI(L7> 

0145 

IF  (ST(  IND,  6 7 EO  -DHL) 

014  7 

571 

CONTINUE 

014  8 

572 

PE 90 (6’  LL,  ERR=  727  ( ( OF  I L ( I 

0149 

DO  573  J = 4,  6 

0150 

K=J-2 

0151 

DO  572  1=1,10 

0152 

573 

MOUT  ( I,  J 7=0F  IL  ( I-  K 7 

0152 

575 

M0UTC1,  S7=Xt'1T 

0154 

T1=SECNDS ( 0 7 

0155 

1010 

DELT9=SECNDS ' T1 7 

0156 

IF  (DELTh  . GE  17  GOTO  10 

0158 

GOTO  1810 

0159 

1020 

DO  5116  J=l, 3 

0160 

5110 

WRITE (8  J+337 (MOUT ( I , J7,  I 

0161 

661 

HRCN0=34 

0162 

N0PEC=8 

0162 

ST( IND. 17=4006 

0164 

RETURN 

0165 

660 

ICON  (17  = ICON-:  1 >+  ISHFT  ( 1, 

0166 

ICON (2 7=0 

016? 

I CON (37  = 1 H51 

0168 

ICON (4 7=1 

0169 

I CON ( 7 7= I CODE (37 

0170 

ICON (8 )=2 

0171 

ICON (5 7=6 

0172 

I CON (6  7 = ST 1 IND, 67 

0172 

ICON ( 9 7 = LEOP 

0174 

IRTN=575 

0175 

GOTO  710 

-7?  19:68  18 
P4000.  OBJ=P400O. 


PBGE  608 
FQR/NOSN/L i : 1 


575 


1 = 1, 100:' 


5 

GOTO  : 
> GOTO 


( £ 
660 


107,  j=i,  3;- 


1=1,  107 
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CORE 1 

08K,  U I C-C  20.  20  1 P4000.  Oej  = P400O 

FOR/NOSN/LI : 1 

C 

C-R  IFS=2,  2 

0176 

580 

IF  (SUING, 9)  EQ  1)  GOTO  585 

0178 

IF  (SUING,  9)  EG.  3 > GOTO  583 

0180 

T1=SECNDS' O > 

0181 

1020 

DEL  T A=SEC  NDS >.  T 1 ) 

0182 

IF  '.DELTA  . G E . 1.2  GOTO  650 

0184 

GOTO  102O 

0185 

650 

PEAO',2  2,  ERR=73)C0I< I ),  1=1,  100) 

0188 

DO  584  L=l, 10O 

0187 

LL  = L 

0188 

IF  (OKU  EG  O ) GOTO  589 

0180 

IF  ( ST( IHD,  6 ) EG  PKU)  GOTO  586 

0182 

IF  (SUING, 6)  EG.  -DICL))  GOTO  670 

0184 

584 

CONTINUE 

0185 

586 

READ(4'  LL,  ERR=73  > ( ( OF  I L 61 , 4),  1 = 1,  10),  4=1,  3) 

0186 

DO  87  J = 4,  6 

0187 

K = J - 3^ 

0198 

DO  87'  1=1,  10 

0189 

87 

M 0 U T ( I , 4)=0FIL(I, K) 

0200 

589 

IF  < S T(  I N D , 9 ) NE  4)  GOTO  585 

0202 

532 

T1=SECNDS  < 0 > 

0202 

1040 

DELTA=SECNDSCT1> 

0204 

IF  (DELTA  . GE  1)  GOTO  1050 

0206 

GOTO  1040 

0207 

1050 

READ (2  3 • ERR  = 72 ) ( D I ( I ) , 1=1,180) 

0208 

DO  588  L=l, 100 

0209 

LL  = L 

0210 

IF  (OKU  . EG.  0>  GOTO  585 

0212 

IF  (SUING,  6)  EG.  DHL))  GOTO  591 

0214 

IF  (SUING,  6)  EG.  -DI(L)>  GOTO  630 

0216 

583 

CONT  ’HUE 

0217 

591 

READ <5  LL, ERR=72 ) ( (OF  I L ( I , J),  1 = 1, 10), 4=1, 3) 

0218 

DO  592  J = 7 , 9 

0219 

K= J-6 

0220 

DO  592  1=1, 10 

0221 

592 

It  OUT  ( I . J ) =0F  I L ( I , K ) 

0222 

585 

HOUT  < 1, 10 >«XMT 

0222 

T1=SECNDS ( O.  > 

0224 

1060 

DEL  TA=SE CUDS ( T 1 ) 

0225 

IF  (DELTA  GE  1)  GOTO  1070 

0227 

GOTO  1060 

0228 

10  70 

DO  5120  4=1.10 

0229 

5120 

WRITE (8  J + 33  > ( MOUT ( I , J),  1=1, 10) 

0220 

NR ON 0=34 

0221 

N 0 R E C = 10 

0222 

ST ( IHD,  1 1=4006 

0222 

RETURN 

0224 

670 

I CON ( 1 ) = I CON ( 1 ) ♦ ISHFT (1, 8 ) 

0225 

ICON' 2)=0 

0226 

I CON ( 3 ) = IH51 

0227 

ICON' 4 • = ! 

0228 

I CON (7  ' = I CODE ( 2 ■ 

0229 

ICON'  8 ' = 2 

0240 

ICON ( 5 )=4 

0241 

ICON ( 6 ) = ST ( IHD. 6) 

0242 

ICON  - 9,' = LEOP 

Burroughs  Corporation 


FORTRAN  IV  V016-02 

C0RE=8SK,  U I C = C 20,  20  I 


FRI  18-MAR-??  19  08:18  PAGE  008 

R4000.  OC,f  = P4U00  FOA.  'NOSN.-'L  I 1 


024  3 

I R T N = 5 3 9 

024  4 

GOTO  710 

0245 

630 

ICON'.  17= ICON'  1 .’  + I S 

HFT'.l,  3 7 

024  6 

I CON  <2 7=0 

024? 

I CON (3  7 = IH51 

0243 

ICON' 4>=1 

0249 

I CON 7 = I CODE  6 2 7 

0250 

I CON  < 8.)  =2 

0251 

I CON i 53  =5 

0252 

I CON «. 6 7 =ST  I N D , 6> 

0255 

I CON  69  ? = LEOP 

8254 

I RTN=5S5 

0255 

710 

I = MOD  6 DEV ST  6 4 7 , 2> 

0258 

IF  <1  . E<3.  1.)  GOTO 

40 

0258 

IF  6 1 . EO.  -1?  GOTO  40 

0280 

DO  60  1=1..  10 

0281 

80 

CONTINUE 

0282 

GOTO  710 

0262 

48 

DO  71  ..1  = 1,  128 

0264 

DO  30  1 = 1,2 

0285 

80 

CONTINUE 

0286 

71 

DE  VST ' 2 ’ = I CON < J ? 

026? 

D E V S T '.  6 7 = 0 

0268 

IF  URTN  EO  700  > 

G 0 TO  7 0 0 

8270 

IF  URTN  EO.  5751 

GOTO  575 

0272 

IF  URTN  EO.  5397 

GOTO  539 

0274 

IF  URTN  . EO.  5857 

GOTO  535 

0276 

26 

NRCNO= 175 

027? 

NOPEC  = 5 

0278 

ST' IND, 1 7=4014 

0279 

RETURN 

c 

GET  FILE  SELECTED 

0230 

72 

I F S = I ri  N C>  L S K f I C 0 D E <.  4 > > 

0281 

I FS= I F S-43 

c 

CK  FOR  INVALID  ENTRV 

0282 

IF  UFS  GE.  S?  IF 

5 = 4 

0284 

IFACUND7  = IFS 

0285 

IF  UFS  GE  17  GOTO  70 

0287 

73 

NRCN0=11 

0288 

N0REC=1 

0289 

RE  TORN 

0290 

70 

DO  75  ,1=1,  2 

0291 

75 

READ 8 133  + J ■ U10UTU,  ,17,  1 = 1,  107 

0292 

DO  76  J=2,5 

0293 

K=, 1 + 1?  3+3*  UFS -17 

0294 

76 

READ 68'  K • v MOUT  I , ,T 

1=1,  10? 

0295 

READ 3 1267'  MOOT 6 I 

,67,  1=1,  107 

0296 

IF  6 NOCHAFt  £ V ' IFS7 

EO.  2?  MOUT (.5 

0298 

IF  < NOCHAPKE V 1 IFS7 

EO.  4 7 MOUT (.5 

0300 

READ68  1377 • HOOT' I 

. 7 7 , 1=1, 107 

0201 

MOOT  <5, 7 7=KEV  TYPE FM 6 IFS7 

0202 

DO  7?  ,1  = 9,  11 

0202 

-7-J 

READ'  3 129  + ,1  MHOUTU,  ,17,  1=1,  107 

0204 

DO  95  ,1  = 1,11 

O205 

95 

WRITE <.3  ,1  + 227' MOUT 

o 

II 

0206 

NRCN0  = 2 4 

I 


FEDERAL  AND  SPECIAL  SYSTEMS  GROUP 


FORTRAN  IV  V010-02  FRI  18-MAR-??  13:  OS':  IS  PAGE  066 

CORE  = 08K.  UIC*C20,  20  1 R4000.  OBJ=R4000.  FOR/NOSN/Ll  :1 

020?  N0REC=11 

028S  ST < I HD, 1> =4002 

0203  RETURN 

0210  END 


FORTRAN  IV  DIAGNOSTICS 

C WARNING  I MSG  #092  VARIABLE  "NOCHAR"  NAME  EXCEEDS  6 CHARACTERS 
C WARNING  I MSG  #092  VARIABLE  "KEVTYP"  NAME  EXCEEDS  6 CHARACTERS 

FOR  --  CP4O00  I ERRORS:  0,  WARNINGS:  2 

> 


Burroughs  Corporation 


FORTRAN  IV  V01B-02  FRI  18-MAR-77  19:20:00  PAGE  001 

CORE=03K,  UIC-C20.  20  J 40001.  OBJ*P40O01.  F0R/N0SN/LI  1 

0001  SUBROUTINE  R4000 
C 

C 

C FILE  ACCESS  MODE  OF  OPERATION 

C 

0002  REAL+8  MOUT.  020-  040,  t EYTYPEF N,  ,\'MT.  OFIL, 

1 ST1,  STD,  AC>E,  UPD,  NO  I,  LID,  TAB,  NUD 

0003  INTEGER  ST, 01 

0004  INTEGER  DEVST<6> 

0005  COMMON  HOI,  LIO,  TAB,  NMD,  S T ( 3 , 9:',  I NO 

0006  DIMENSION  OF  I L < 10,  3 > , 0 U 100 > 

000?  COMMON  /DSK/  II.  12,  13,  14,  15,  16,  116 

0003  COMMON  /U800/  MOUTC10,  11  ;■ . NRCNO,  NOREC 

0009  COMMON  /MD04/N0CHARKEY<  10>.  KE VT V PERM (.  1 0 ? 

0810  COMMON  /F01/IFAC<3? 

0011  COMMON  /LOOP/ 1 CODE ( 123 ? , MSK,  LSK 

0012  COMMON  /CP  AC.'  I CON  < 128  > , I CFLG 

0013  COMMON  /MiriO/DEVST 

0014  DATA  020,040  /8H2  , 8H4  / 

0015  DATA  XMT , ST1,  STD/ 

1'  PRS  XMIT-  , ' ST  ' , ' ST.  DO  V / 

8016  DATA  NOCHAPKEY/2,  2,  2,  2,  4,  2 4,  2,  2,  2/ 

001?  DATA  KEYTVPEFM/8H  LET-DIG, SH  LET-DIG,  8H  LET-DIG,  8H  LET-DIG, 

1 3HALPHANUM • SH  LET-DIG, 8HALPHANUM, 

28HLET-0IG  , 8H  LET- DIG,  3H  DIGIT/ 

0013  DATA  ADE/'  ADDED' / 

0019  DATA  UP0/8H  UPDATED/ 


0020 

DATA  IH51.LE0P, 

K V M S K / " 4 0 5 

, "177777,  “77577/ . 

0021 

IF  < S T ( I N D , 1 ? . 

EO.  4000,' 

GOTO  72 

0022 

IF  (ST C I ND,  1 7 . 

EO.  4002? 

GOTO  22 

0025 

IF  < S T ( I ND,  1 > . 

EO.  4003? 

GOTO  23 

0027 

IF  ( ST ( I ND, 1 ? 

£0.  40O4  J 

GOTO  24 

0029 

IF  ( S T ( I ND,  1 > 

E 0 . 4 0 0 5 :• 

GOTO  25 

0021 

IF  (ST(IND,  1?  . 

EO.  4086? 

GOTO  26 

0033 

CALL  P4O01 

0034 

RETURN 

0035 

22 

MOD  T VP  = I AND  < LSL 

, I CODE'. 4 ' ? 

0026 

M0DTVP=M0DTVP-4 

8 

0037 

I F S=  I F AC <.  I ND  ? 

C 

RD  TYPE  OF  MOD 

C 

NO  MOD  IF ICAT I ON  - ACCESS 

ONLY 

C 

CK  FOR  CROSS - 

REFERENCIN 

u 

0028 

IF  < MODTVP  EO. 

1>  GOTO  2 

60 

0040 

IF  (IPS  EQ.  2> 

GOTO  278 

0042 

IF  <IFS  EO  3 > 

GOTO  278 

■'04  4 

IF  ( IFS  EO  4? 

GOTO  279 

0046 

IF  (MODTVP  EQ. 

2?  GOTO  2 

63 

0048 

GOTO  73 

4 

0049 

273 

N P C N 0 = 1 4 O 

0050 

N0REC=6 

0051 

ST  < I HD.  1 < = 4003 

0852 

RETURN 

0052 

279 

HR  CN0  = 14  7 

0054 

N 0 P E C = 9 

0055 

S T < IND. 1 J = 4004 

0056 

RETURN 
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FORTRAN  IV  V01 6-02  FRI  18-MAR-??  1?. 20:00  PAGE  002 

CORE  = 03K.  U IC  = C 20,  20  I 40O01. Oei=P40001  F OR.'NOSN/L I 1 


005? 

280 

N R C N 0 = 1 5 7 

0058 

N0REC-1 

0O59 

S T < IMP,  1 ' = 4008 

00 1',0 

RETURN 

0081 

282 

NRCHO* 158 

0082 

ST  LINC>,  1 ' = 4005 

0O8.2 

N0REC=1 

0O84 

RETURN 

0 vi  6 5 

23 

STUNp.  8>=IANtKLSK,  IC0PE'.4>> 

0088 

ST  <1 1 NC>-  8)=STUNC>,  8 I' -48 

c 

REAP  CROSS-FEF  1 

0067 

NRCN0=158 

0088 

N0R£C=1 

0O89 

S T < INC).  1 '=4005 

00  70 

RETURN 

00  21 

24 

STUNC'.  9 > = I AND*  LSI.  I COPE  • 4 ■> 

0022 

STUMP- 9 > = S T i IMP, 9 -48 

C 

RP  C-R  2 

0072  ' 

NRCN0=156 

0074 

NOPEC-1 

0075 

SI  UNP.  1 >=4005 

0078 

RETURN 

0077 

25 

ST  UNP.  8 '=1  AND'  KVMSF.  ICOPE'  4 > > 

0078 

IF S=  I F AC < IMP  :■ 

C 

Ci £ T ST-.  IMD,  b > 

0079 

REAP  v 2'  IFS,  EPP  = 72)».  PI(  I.'.  1 = 1.  1001’ 

0080 

DO  550  1=1,100 

0081 

ST'.  INP,  7 > = K 

0082 

IF  CDI'fO  £0  0>  GOTO  585 

0084 

IF  (.  5 T v I f * C>  • 6 • E 0 C>  l ( K ;•  GOT  0 5 6 0 

0088 

IF  < S T U NP,  8 £Q  -DltK))  GOTO  800 

0088 

550 

CONTINUE 

c 

KEV  EXISTS 

0089 

580 

LU  = IFS  + 2 

0090 

REAP'LU  ST'  INP-  ?-’,  ERR  = ?3  M (OF  I LCl , J>.  1=1.  10).  1 = 1 

0091 

PO  582  .1  = 1.3 

00S2 

00  582  1=1- 10 

0092 

582 

MOUTU- J)=OFILU.  1) 

$094 

IF  UFS  . EQ.  2 ) GOTO  570 

0098 

IF  UFS  E0.  3)  GOTO  570 

0098 

IF  UFS  EO.  4)  GOTO  580 

c 

ELSE  NO  C-R 

0 1 0 © 

MOUTU,  5 > = X M T 

0101 

DO  5100  ,1=1.5 

0102 

5100 

WRITE'.  8 1 + 32  :■ ' flOU  T < I,  J>,  1=1-  101' 

0102 

NRCN0=24 

0104 

N0REC=5 

0105 

STUMP.  1 >=4008 

0108 

RETURN 

010? 

8O0 

I CON  < 1 ' = I CON ' 1 .)  + I SHF  T ( 1 . 8 > 

010$ 

I CON L 2 > = 0 

0109 

ICON' 3)=IH51 

0110 

I CON 4 > = 1 

0111 

ICON' 5>=IFS+2 

0112 

I C 0 N < 6 ,•  - 5 T I f 1 0 • *£  > 

0112 

ICON'  ? :■  = 1C0C>E<  2 ) 
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Burroughs  Corporation 


FORTRAN  IV 

V01E-02  FRI  18-MAR-7?  18 

20  00  PAGE  002 

C0RE  = 

03K,  UIC=C20, 20J  40001 

OE..I  = P4O001.  FOR/NOSN/l!  1 

0114 

1 CON  c 3 7 =2 

0115 

I C 0 N C 8 7 = L E 0 P 

01  It' 

IRTN=?00 

0117 

GOTO  710 

011S 

700 

IF  CIFS  . EG.  2>  GOTO  570 

0120 

IF  CIFS  . EG.  37  GOTO  570 

0122 

IF  CIFS  EG.  4 7 GOTO  530 

0124 

N 0 R E C = 0 

0125 

STCIND,  1 .'=4006 

0126 

RETURN 

c 

RECORD  NOT  EXIST <NK> 

0127 

565 

NRCN0=210 

0128 

N0REC=1 

0128 

STCIND, 17=4006 

0120 

RETURN 

C 

C-R  IFS=04 

. 

0121 

570 

IF  C STCIND. 8 7 EG.  2 7 GOTO  575 

0122 

T 1 = S E C N D S C O . 7 

0124 

1000 

DELTA=SECNDS( Tl> 

0125 

IF  CDELTfl  . GE  1.)  GOTO  640 

0127 

GOTO  1000 

c 

ELSE  LOCATE  RECORD 

012S 

646 

READ C 2'  4.  E P R = 7 3 ;■  <DUI7,  1 = 1-  1007 

0128 

DO  571  L =1.100 

0140 

LL  = L 

0141 

IF  C D I C L 7 EG  07  GOTO  575 

014  2 

IF  CSTCIND, 67  EG.  DICL77  GOTO  572 

0145 

IF  CST<  IND. 67  EG.  -DICL77  GOTO  660 

‘ 

0147 

571 

CONT INUE 

0148 

572 

READC6  LL,  E RR  = 73  7 C C OF  I L c I , J>,  1=1,  107 

7 J = 

0148 

DO  5 73  J=4,  6 

0150 

K = J - 3 

0151 

DO  573  1=1. 10 

0152 

572 

MOUTCI, J7  = 0FILC I , K 7 

1 

0152 

575 

MOUTCI,  3 7 = X M T 

0154 

T 1 = S E C N D S C 0 . 7 

0155 

1010 

DELTA=SECNDScTl 7 

0156 

IF  CDELTfl  GE  17  GOTO  1020 

0158 

GOTO  1O10 

0158 

1020 

DO  5110  J = l, 3 

0160 

5110 

URITEcS  J +33 7CM0UTCI, J),  1=1, 107 

0161 

661 

NRCN0=34 

! 

0162 

N 0 R £ C = 8 

0162 

ST  C 1ND, 1 7=4006 

0164 

RETURN 

0165 

660 

ICONd7  = ICONC17  + ISHFT< 1,  87 

0166 

I CON C 2 7=0 

0167 

I CON  C 3 7= I H51 

0168 

IC0NC4  7 = 1 

0168 

I C 0 N C 7 7 = I C 0 D E C 3 7 

0170 

I CON CS 7 = 2 

0171 

ICON c 5 >=6 

0172 

ICON  C 6 7=ST  c I NO. 67 

0172 

I CON  C 8 7 = LEOP 

0174 

I P T N = 5 7 5 

0175 

GOTO  710 

1-156 
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FEDERAL  AND  SPECIAL  SYSTEMS  GROUP 


FORTRAN  IV 

VU1B-02  FRI  18-MRR- 7?  10 

COR£  = 

0 8 K , U I C = C 2 0 , 2 0 1 40001 

C 

C-R  I FS=2 ■ 3 

0176 

530 

IF  ( S T C I M C> , 0 1 . EG.  1>  GOTO  585 

0178 

IF  (STUND,  9)  EG  31  GOTO  583 

0180 

ti=secnos<  o.  i 

0181 

1030 

OELTR=SE  C NO  £ (.  T 1 > 

0182 

IF  < D E L T R , GE  1 1 GOTO  650 

0184 

GOTO  1030 

0185 

650 

REHDC2'  2,  EPP=73>  c.  C>  I <.  Il,I  =1,  1001 

0188 

00  584  L = 1 • 100 

0187 

LL  = L 

0188 

IF  t D I <■  L>  EO.  Ol  GOTO  580 

0180 

IF  <ST(INO,  61  . EO.  Mail  GOTO  586 

0102 

IF  <ST<IN0,6>  EO.  -Mail  GOTO  670 

0104 

534 

CONTINUE 

0105 

586 

R E R 0 ( 4 LL,  ERP  = 73K<0FIUCI,  Jl,  1=1,  101 

0106 

00  87  J=4, 6 

0107 

K = J-3 

0108 

00  87  I =1, 10 

0100 

87 

MOUTU,  J1=0FIHI,  K 1 

0200 

530 

IF  (SUIND,  0)  . NE.  41  GOTO  585 

0282 

533 

T1=SECNOS<0  i 

£ 2 2 

104  0 

OELTR=SECNDS<.  Til 

0204 

IF  (.OELTR  GE.  11  GOTO  1050 

0206 

GOTO  1O40 

0207 

1050 

RERO<  2 3, ERR  = 72><  01 < 1 1,  1 = 1, 1001 

0208 

00  583  L=1 ■ 100 

0200 

LL  = L 

0210 

IF  (Dial  EO  01  GOTO  585 

8212 

IF  CSTsINO,  6!  EO.  Ola  1 1 GOTO  501 

0214 

IF  CSTCINO, 61  EG.  -0K.L11  GOTO  680 

0216 

583 

CONTINUE 

0217 

501 

R E R 0 5 ' LL,  ERR=73>  < ( OF  1L  < I,  Jl,  1=1,  101 

0218 

00  502  J = 7 , 0 

0210 

K = J - 6 

0220 

00  502  1=1,10 

0221 

502 

MOOT  L I,  J > = 0F  IL ' I,  K 1 

0222 

585 

MOUTt  1,  101  = X f'l  T 

0223 

Tl  = SECN0SO3  1 

0224 

1068 

0 E L T R = S £ C N 0 £ t T i 

8225 

IF  LOElTR  ijfc  li  GOTO  1070 

022  7 

GOTO  1060 

0228 

1070 

00  5120  J=l, 10 

0220 

5120 

WRITE <3  J + 33  ) < MOOT U, Jl,  1 = 1, 10  > 

0230 

N P C N 0 = 34 

0231 

N 0 R E C = 1 0 

023  2 

ST  < INO,  1 1 = 4006 

0233 

RETURN 

0274 

6 70 

ICON* 1 ) = I CON d > + ISHFT< 1 ■ 8) 

0225 

I CON ( 2 1 =0 

022  6 

I CON ( 3l  = I H51 

023  7 

ICON' 4 • = ! 

0238 

I CON  (.7 1 = 1 CODE  <.31 

0220 

I CON <8 ' = 2 

024  0 

ICON'. 5 '=4 

0241 

ICON  1 6 l *ST  t INO, 61 

0242 

I CON (0 l = LEOP 

20  00 


HRGE  004 
lOSN/Ll  1 


..1  = 1,  2: 
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Burroughs  Corporation 


FORTRAN  IV 

V0ie-02  FRI 

C0RE  = 

83K,  IJIC  = C20,20I 

024  3 

IRTN=5S9 

024  4 

GOTO  710 

024  5 

680 

ICON'  1 ■ = I CON » 1 ;•  + I SHFT  1 

024O 

I C0TK  2 >=8 

024  7 

icon  t 2 ,■  = I H 5 1 

0248 

ICON. 4 ) = 1 

0249 

I CON ( 7 > = I CODE ( 2 > 

0250 

I C 0 N < 8 > = 2 

0251 

ICON'.  5>  = 5 

0252 

IC0N(.6.'=ST f IND.  6 1 

0253 

ICON. 9 >=LEOP 

8254 

I RTN=5S5 

0255 

718 

I =M0D < DE VS T ' 4 7,  2> 

0256 

IF  (I  EO.  1 > GOTO  48 

0258 

IF  <1  EO.  -17  GOTO  40 

8268 

DO  60  1 = 1,  10 

8261 

60 

corn  I HUE 

0262 

GOTO  710 

8262 

4 0 

DO  71  J = l, 128 

8264 

DO  80  1 = 1.  3 * 

8265 

80 

CONTINUE 

8266 

71 

DEVST  <.2  1 = I C 0 N ..  -1  .■ 

8267 

D E V S T ( 6 ' = 0 

0268 

IF  (.IRTN  EO  700!'  GOTO 

8270 

IF  (.IRTN  EO  575  > GOTO 

02  72 

IF  (.IRTN  EO.  589  7 GOTO 

82  74 

IF  (IRTN  EO  585,'  GOTO 

02  76 

26 

NPC  N0  = 1 75 

8277 

N0REC=5 

8278 

S T ( I N D • 17=4014 

0279 

RETURN 

C 

GET  FILE  SELECTED 

8280 

72 

IFS  = I A N D ( LSK ■ I C 0 D E < 4 :■  > 

6281 

IFS=lFS-43 

C 

CK  FOR  INVALID  ENTPV 

8282 

IF  (IFS  G£  5 ' I F S = 4 

0284 

IF  AC  <■  IND  7 = IFS 

8285 

IF  (IFS  GE  17  GOTO  70 

028  7 

73 

N P C N 0 = 1 1 

0288 

N0PEC=1 

8289 

RETURN 

0298 

78 

DO  75  J=l, 2 

8291 

75 

READ (8  133  + J 7 < NOIJT<  I-  J}, 

8292 

DO  76  J = 2, 5 

8292 

K = J + 178  + 2*  c.  IFS-17 

0294 

76 

RE  AD  (.S'  r.  ■ < MOOT  (1.17,1  = 1 

0295 

READ(8'  136  7 (.  M 0 U T < I,  6 7,  I 

8296 

IF  '.NOCHAR!  EYc  IFS  7 £0 

0298 

IF  ''NOCHAR!  EV',  IFS  ' EO 

0208 

READ'S'  13  7 :■ MOUT  (.  1 , 7.'.  I" 

0281 

MOUT (.5.  7 1 = ! £ V T VPEFN < IFS 

0282 

DO  77  J = 9 ■ 11 

0282 

77 

RE  AD  (8  129+..T  • ' MOUTc.  I . J . 

0304 

DO  95  J = l,  11 

0205 

95 

WPI  TE(  3'  1+337  '.MOUT  < l,  J> 

03  86 

N R C N 0 = 3 4 

8~MAR-77  19  20  00  R AGt  005 

40001  oeJ=P4O0oi  fok/nosn/'li  i 


’00 

■.75 

>89 

-.95 


I = 1 , 1 0 '} 


10'. 

1,  10,' 

2>  MOUTc,  5.  6>=020 
•4  . Hour  I 5,  6 '=041! 
1.  10  ' 


[=1.  &0> 

f*l.  10  ' 
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- FEDERAL  AND  SPECIAL  SYSTEMS  GROUP 


FORTRAN  IV  V01B-02  FRI  18-MAR-??  19:20:00  RAGE  008 

CORE=03K,  UIC  = C 20- 20  J 40001.  OBJ=P40001  FOR/NOSN/L I 1 

030?  N 0 R E C = 1 1 

0308  STCINO,  1>  = 4O02 

0309  RETURN 

0310  END 


FORTRAN  IV  DIAGNOSTICS 

C WARNING  ']  MSG  4092  VARIABLE  "NOCHAR"  NAME  EXCEEDS  6 CHARACTERS 
C WARNING  I MSG  #092  VARIABLE  “KEVTVP"  NAME  EXCEEDS  6 CHARACTERS 

FOR  --  C R4000  I ERRORS:  0,  WARNINGS:  2 

> 


FOR  HST  0 B J = H S T FOR/NOSN/LI  1 
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IUPDEL  = IAND 
(LSK,  ICODE(4)) 
IUPDEL  = 

IUPDEL  - 48 


ICON(l)  = ICON(l)  + 
ISHFT  (1.  8) 

ICON  (2)  = 0 
ICON(3)  = IH51 


IP'S  = IF.ACdND) 
ST(IND.  1)  = 4012 


ICON  (4)  = 4 
ICON(5)  = IFS  + 2 
ICON(6)  = ST(IND.  6) 
ICON(7)  = LE  OP 


IUPDEL 
= 2 


NojNRCNO  = 162 
HNOREC  = 3 


.RETURN 


/READ  RECORD/ 
I IFS  OF  / 

EFDIR  INTO  / 
DI  / 


RETURN 


DI(ST(IND.  7)+l) 
= 0 


DKSTdND.  7)  = 0 


DI(ST(IND,  7)  + 1) 
v * 0 / 


WRITE  DI 
TO  RECORD  IFS 
OF  EFDIR  I 


NRCNO  = 174 
NOREC  = 6 
STdND.  1)  = 4019 


Y^sJ  DKSTdND.  7)  = 

> H 120240  (OCTAL) 


Figure  1-15.  (Cont.) 
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0001 


0002 

0003 

0004 

0005 

0006 

0007 

0008 

0009 

0010 
0011 
0012 

0013 

0014 

0015 

0016 

0017 

0018 

0019 

0020 
0021 
0023 
0025 
0027 
0029 
0031 

0033 

0034 


0035 

0036 

0037 

0038 

0039 
0041 
0043 

0045 

0046 

0047 

0048 

0049 

0050 

0051 

0052 
2053 

0054 

0055 


SUBROUTINE  F4001 
C 

c 

C FILE  ACCESS  MODE  OF  OPERATION 
C 

REAL*8  M0UT,Q2Q.Q40,KEYTYF'EFM,XMT,0FIL, 

1 ST1 , STD  > ABE:  , UF'D,NDI>LIB»TAB>  NWD 
INTEGER  ST,DI 

DIMENSION  OEIL(10,3),DI(100> 

COMMON  NDI > L ID > TAB » NWD » ST ( 3 » 9 > > I ND 
COMMON  /DSK/  I 1 , 12 . 13 , 14 . 15 , 16 » I 16 
COMMON  /UOOO/  MOUT (10,11), NRCNO , NOREC 
COMMON  /MD04/  NOCHARKE Y (10), N'E YTYF'EFM (10) 
COMMON  /F01/IFAC(3) 

COMMON  /LOOF'/ICODE  < 1 28 ) f MSK , LSK 
COMMON  /CPAC/ICDN ( 1 28 ) » I CFLG 
REAL*8  IFAR 

DIMENSION  LINE(40) , IFAR( 10) 

EQUIVALENCE (LINE, IFAR) 

DATA  Q2Q > Q4Q/ " 2 't'  4 '/ 

DATA  XMT , ST1 » STD/ 

l'PRS  XMIT'r'ST.  ','ST.  DO  Y'/ 

DATA  ABE/'  ADDED  '/ 

DATA  UPD/' UPDATED  '/ 

DATA  ISPC/" 120240/ 

DATA  IH51 > LEOF1  , KYMSK/ * 2401 , ’ 1 77777 , * 77577/ 
IF  ( ST( IND , 1 ) .EQ.  4006 ) GOTO  28 
IF  ( ST  ( IND , 1 > .EQ.  4009)  GOTO  29 
IF  ( ST  ( IND f 1 ) .EQ.  4010)  GOTO  30 
IF  (ST(IND,1>  .EQ.  4011)  GOTO  31 
IF  < ST ( IND » 1 ) .EQ.  4012)  GOTO  32 
IF  < ST ( IND il)  .EQ.  4014)  GOTO  34 
28  ST(INDf6)  = IAND( KYMSK , I CODE ( 4 ) ) 
IFS=IFAC(IND> 

C FOR  RECORD  MODIFICATION 

C RECORD  LOCK  OCCURS  HERE 

READ ( 8 ' 1 59  > ( MOUT ( I >1) >1*1,10) 

READ(2'IFS>  ERR= 1415)(DI(I >>1  = 1,100) 

DO  850  K=1 , 99 
ST < IND>  7)=K 

IF  (ST (IND, 6)  .EQ.  DI(K>>  GOTO  864 
IF  ( ST ( IND > 6 ) .EQ.  -l)I(K))  GOTO  500 
850  IF  < D I ( K > .EQ.  0)  GOTO  860 
C RECORD  DOES  NOT  EXIST 

860  CONTINUE 

DO  886  J=3 , 6 

886  READ<8'  J+163HM0UT(  I >J)  >1  = 1,10) 

DO  890  J=1 >6 

890  URITE(8'33+J> (MOUT (I. J> ,I=1>10> 

NRCN0=34 

N0REC=6 

ST( IND, 1 >=4009 
RETURN 

C RECORD  EXISTS 

864  ST(IND,1)=4011 
LU=IFS+2 
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0056 

REAP ( LU ' ST ( I ND » 7 ) » ERR=14 15  > ( < OFIL < I , J ) » 1 = 1 r 10 > » J=1 r 3 ) 

0057 

PO  883  J=1 » 3 

0058 

PO  883  1=1,10 

0059 

883 

MOUT (I»J)=0FIL(I»J> 

0060 

PO  884  J=4 » 6 

0061 

884 

REAP ( 8 ' J+156 ) ( MOUT  (I, J), 1=1,10) 

0062 

PO  8100  J=1 , 6 

0063 

8100 

WRITE(8'J+33) ( MOUT  < I * J ) » 1=1,10) 

0064 

NRCN0=34 

0065 

N0REC=6 

0066 

RETURN 

0067 

500 

ICON ( 1 ) =IC0N< 1 ) +ISHFT (1,8) 

0068 

ICON  < 2 ) =0 

0069 

ICON ( 3 > = IH51 

0070 

ICON  < 4 ) = 1 

0071 

ICON (5)=IFS+2 

0072 

ICON (6>=ST(IND»6> 

0073 

IC0N<7)=IC0PE(3) 

0074 

ICON  < 8 ) = 1 

0075 

IC0N(9)=LE0P 

0076 

ICFLG=1 

0077 

NOREC =0 

0078 

ST  < INP» 1 )=401 1 

0079 

RETURN 

0080 

29 

I APD=I  ANP<  l.SK , I COPE  ( 4 ) ) 

0081 

IAPP=IAPP-48 

00G2 

IFS= IFAC ( IND ) 

0083 

IF  ( I ADD  .Ef).  2)  GOTO  961 

C 

APP  A RECORD 

0085 

PO  930  J=1 * 2 

0086 

930 

REAP (8 ' 133+ J) (MOUT < 1 1 J) ,1  = 1,10) 

0087 

PO  935  J=3,5 

0088 

K=J+178+3*<IFS-1> 

0089 

935 

REAP  <8'K)(M0UT(I,J),I  = 1,10) 

0090 

PO  940  J=6 , 9 

0091 

940 

REAP(8'J+164) <MOUT< I, J) ,1=1,10) 

0092 

IF  ( NOCHARKEY  < IFS ) .EQ.  2)  MOUT ( 3 , 6 ) =020 

0094 

IF  <NOCHARKEY< IFS)  .EO.  4)  MOUT ( 3 , 6 ) =040 

0096 

MOUT (4,7) =KEYTYPEFM ( IFS ) 

0097 

DO  990  J= 1 , 9 

0098 

990 

WRITE (S' J+33  > ( MOUT  <I,J),I  = 1,10) 

0099 

NRCN0=34 

0100 

N0REC=9 

0101 

ST ( INP, 1 )=4010 

0102 

RETURN 

c 

DO  NOT  ADD  A RECORD 

0103 

961 

NRCN0=174 

0104 

N0REC=6 

c 

RECORD  UNLOCK'  SHOULD  OCCUR  HERE 

OIOS 

ST  < INP ,1)  = 4014 

0106 

RETURN 

0107 

30 

IFS=IFAC< INP  > 

0108 

LU=IFS+2 

0109 

PO  300  J=1 ,40 

0110 

300 

L INE  ( J ) = ICODE  < J-f  3 ) 

0111 

DO  310  1=1,10 

I 
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CORE= 

:08Kr  UIC=C20f203  P4001 .0BJ=P4001 .FOR/NOSN/LI ! 1 

0112 

310 

OF IL ( I > 1 ) =IFAR ( I > 

C 

ADD  A NEW  RECORD 

0113 

DO  1050  I=1f10 

0114 

DO  1050  J=2 » 3 

0115 

1050 

OFILdr  J)=ADE 

011<S 

READ  ( 2 ' IFS  f ERR=1 415  > <DI<I)tI  = lF1 00 ) 

0117 

DO  1055  K=1 f 99 

0118 

ST ( IND  f 7 ) =K 

0119 

IF  <DI(K)  .EQ.  0)  GOTO  1060 

0121 

1055 

CONTINUE 

0122 

1060 

DI ( ST ( IND  f 7 ) )=ST(INDf6) 

0123 

DI(ST(INDf7)+1)=0 

0124 

WRITE(LU'ST(INDf7> ,ERR=1415) ( ( OFIL < I f J > f 1 = 1 f 1 0 > f J=1 f 3 > 

0125 

WRITE < 2 ' IFS  f ERR=1 4 1 5 ) ( DI ( I > f 1-1 > 100) 

0126 

NRCN0=174 

0127 

N0REC=6 

0128 

ST( INDf 1 >=4014 

0129 

ICON  < 1 ) = ICON ( 1 ) + ISHFT ( 1 f 8 ) 

0130 

ICON ( 2 ) =0 

0131 

ICON < 3 ) =IH51 

0132 

ICON ( 4 ) =3 

0133 

ICON  ( 5 ) =IFS+2 

0134 

ICON (6)=ST(I ND  f 6 > 

0135 

IC0N(7>=LE0P 

0136 

ICFLG=1 

0137 

RETURN 

0138 

31 

IUPDEL=IAND<LSKfIC0DE(4) > 

0139 

IUPDEL— IUF‘DEL-48 

0140 

IFS= IFAC < IND ) 

0141 

ST  < IND  f 1 ) =401 2 

0142 

IF  (IUPDEL  .EQ.  2)  GOTO  1161 

C 

UPDATE  RECORD 

0144 

NRCN0=162 

0145 

N0REC=3 

0146 

RETURN 

c 

DELETE  RECORD 

0147 

1161 

CONTINUE 

0148 

READ ( 2 ' IFS  f ERR= 1415 ) ( DI ( I ) f 1 = 1 f 100 ) 

0149 

IF  (DKS1  'INDf7)  + 1>  .EQ.  0)  DI  ( ST  ( IND  f 7 ) ) =o' 

0151 

IF  (DI(ST(1NDf7)+1)  .NE.  0)  DI < ST ( IND f 7 > >=ISPC 

0153 

WRITE ( 2 ' IFS  f ERR=1 4 15 ) (DI(I)fIfIfIOO) 

0154 

NRCN0=174 

0155 

N0REC=6 

0156 

ST ( INDf 1 )=4014 

0157 

IC0N(1'=IC0N(1)+ISHFT(1f8> 

0158 

ICON ( 2 ) =0 

0159 

ICON ( 3 ) = IH51 

0160 

ICON ( 4 ) =4 

0161 

I CON (5>=IFS+2 

0162 

ICON ( 6 )=ST ( INDf6 ) 

0163 

ICON ( 7 ) =LEOP 

0164 

ICFLG-1 

0165 

RETURN 

0166 

32 

DO  400  J=1 f 40 

0167 

400 

LINE (J)=IC0DE(J+3) 

0168 

DP  410  1=1 f 10 
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0169 

410 

OF I L ( I » 1 ) = I F AR  < I ) 

0170 

IFS=IFAC(IND) 

0171 

READ(2'IFSfERR=1415)(DI < I > f 1 = 1 f 100) 

0172 

DO  1500  K'=l  r 99 

0173 

ST  < IND » 7 ) =K 

0174 

IF  <ST( INDf  6 ) .EQ.  DI(K>)  GOTO  1510 

0176 

IF  ( ST  < I ND  f 6 > .EQ.  -DKK))  GOTO  510 

0178 

1500 

IF  (DKK)  .EQ.  0)  GOTO  530 

0180 

1510 

LU=IFS+2 

0181 

DO  1250  1=1 f 10 

0182 

DO  1250  J=2 1 3 

0183 

1250 

OFIL(IfJ)=UPD 

0184 

WRITE ( LU 'ST(INDf7)f  ERR= 1 4 15 ) ( ( OFIL ( IfJ)fI=1f10)f J=1 f 3 > 

0185 

530 

NRCN0=174 

0186 

NOREC=6 

0187 

ST ( IND  f 1 ) =40 1 4 

0188 

RETURN 

0189 

510 

ICON ( 1 ) = IC0N ( 1 ) +ISHFT ( 1 f 8 ) 

0190 

ICON ( 2 > =0 

0191 

ICON ( 3 ) = IH51 

0192 

ICON  < 4 ) =2 

0193 

ICON ( 5 ) =IFS+2 

0194 

ICON  <6)=ST(INDf6) 

0193 

DO  520  J=1 f 40 

0196 

320 

ICON ( J + 6 ) =L INE  < J > 

0197 

IC0N(47)=LE0P 

0198 

ICFLG=1 

0199 

GOTO  530 

0200 

34 

1=IAND(LSKfIC0DE(4) ) 

0201 

1=1-48 

C 

MODE  4 SWITCH  OUT 

0202 

IF  <1  .EQ.  1)  GOTO  1470 

0204 

IF  (I  .EQ.  2)  GOTO  144 

0206 

IF  (I  .EQ.  3)  GOTO  146 

0208 

IF  (I  .EQ.  4)  GOTO  148 

0210 

IF  (I  .EQ.  5)  GOTO  149 

0212 

1415 

NRCND=1 1 

0213 

N0REC=1 

0214 

RETURN 

0215 

1470 

NRCN0=137 

0216 

N0REC=3 

0217 

ST ( IND  f 1 ) =4002 

0218 

RETURN 

0219 

144 

NRCN0=127 

0220 

N0REC=6 

0221 

ST(INDf1 >=4000 

0222 

RETURN 

0223 

146 

NRCN0=5 

0224 

N0REC=6 

0225 

ST ( IND  f 1 > =0004 

0226 

RETURN 

0227 

148 

NRCN0=21 

0228 

N0REC= 1 

0229 

ST(INDf1 >=9999 

0230 

RETURN 

0231 

149 

LU=IFAC ( IND ) +2 

i 
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0232 

IFS=IFAC  < IND ) 

0233 

READ < 2 ,IFSrERR=1415>(DI(I>»I  = l»l 00  > 

0234 

DO  1520  K=1 f 99 

0235 

ST ( I NPf  7 ) =K 

0236 

IF  < ST  ( IND f 6 ) .EO.  DI(K')>  GOTO  1530 

0238 

IF  < ST < IND » 6 ) .EQ.  - D I < K ) > GOTO  540 

0240 

1520 

IF  (DICK)  .EQ.  0)  GOTO  550 

0242 

1530 

READ (LU ' ST  < INDf  7 > f ERR=1 4 1 5 ) ( ( OFIL ( I » J ) f I=1f10)fJ=1f3> 

0243 

DO  150  J=1 » 3 

0244 

DO  150  I=1f10 

0245 

150 

MOUT  < I » J ) =OFIL ( I f J ) 

0246 

MOUT ( 1 f 5 ) =XMT 

0247 

DO  151  J=1f5 

0248 

151 

WRITE(8'J+33) (M0UT(IfJ)fI=1,10) 

0249 

550 

NRCN0=34 

0250 

N0REC--=5 

0251 

ST  < INDf 1 >=4006 

0252 

RETURN 

0253 

540 

ICON ( 1 ) = ICON  < 1 ) + ISHFT ( 1 f 8 ) 

0254 

ICON  < 2 ) =0 

0255 

ICON  < 3 ) = IH51 

0256 

ICON ( 4 ) =1 

0257 

IC0N<5)=IFS+2 

0258 

ICON  <6>=ST(INPf6> 

0259 

I CON ( 7 ) = ICODE ( 3 > 

0260 

ICON ( 8 ) =2 

0261 

ICON  ( 9 ) =LEOF' 

0262 

ICFLG=1 

0263 

N0REC=0 

0264 

ST ( IND  f1)=4006 

0265 

RETURN 

0266 

END 

FORTRAN  IV  DIAGNOSTICS 

t WARNING  ] MSG  *092  VARIABLE  'NOCHAR’  NAMF  EXCEEDS  6 CHARACTERS 
E WARNING  ] MSG  *092  VARIADLE  ’KEYTYP*  NAME  EXCEEDS  6 CHARACTERS 

FOR  — CF'4001  3 ERRORS!  0,  WARNINGS!  2 

> 
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0001 


0002 

0003 

0004 

0005 

0006 

0007 

0008 

0009 

0010 
0011 
0012 

0013 

0014 

0015 

0016 

0017 

0018 

0019 

0020 
0021 
0023 
0025 
0027 
0029 
0031 

0033 

0034 


0033 

0036 

0037 

0038 

0039 
0041 


SUBROUTINE  P4001 
C 

c 

C FILE  ACCESS  MODE  OF  OPERATION 
C 

REAL*8  MOUT  f 020 f 040 f KEYTYPEFM f XMT  f OFIL  f 
1 ST  1 f STD  f ABE  f UF'D  f NDI  f L I D f TAB , NUD 

INTEGER  STfDI 

DIMENSION  0FIL<10f3>fDI(100> 

COMMON  NDI  f L ID  f TAB  fNUIDfST(3f9)fIND 
COMMON  /DSKV  1 1 f 1 2 > 1 3 f 14 f 15 f 16 f 1 1 6 
COMMON  /U 000/  MOUT(10f11)fNRCNO,NOREC 
COMMON  /MD04/  NOCHARKEY < 10 > f KEYTYPEFM < 10 > 
COMMON  /F01 /I FAC ( 3 ) 

COMMON  /LOOP/ICODE( 128) fMSKfLSK 
COMMON  /CPAC/ICON ( 1 28  > f I CFLG 
REAL*B  I FAR 

DIMENSION  L I NE ( 40 > f I FAR (10) 

EQUIVALENCE ( LINE  f IFAR ) 

DATA  020 f 040/ ' 2 ' f ' 4 '/ 

DATA  XMTfSTIfSTD/ 

l'PRS  XMIT'f'ST.  'f'ST.  DO  Y'/ 

DATA  ADE/'  ADDED  '/ 

DATA  UPD/ 'UPDATED  '/ 

DATA  ISPC/1 120240/ 

DATA  IH51 fLE0PfKYMSK/-405f " 177777 r “77577/ 
IF  (ST(INDfI)  .EQ.  4008)  GOTO  28 
IF  (ST(INDfI)  .EO.  4009)  GOTO  29 
IF  <ST<INDf1>  .EQ.  4010)  GOTO  30 
IF  (ST(INDfI)  .EQ.  4011)  GOTO  31 
IF  (ST(INDfI)  .EQ.  4012)  GOTO  32 
IF  (ST(INDfI)  .EO.  4014)  GOTO  34 
28  ST ( IND f 6 ) = 1 AND < KYMSK fIC0DE<4) ) 

IFS=IFAC ( I ND ) 

C FOR  RECORD  MODIFICATION. 

C RECORD  LOCK  OCCURS  HERE 

READ (8 '159) (MOUT (I , 1 ) , 1=1 f 10) 

READ ( 2 ' IFS f ERR=1 4 1 5 > < DI ( I ) f 1 = 1 f 100 ) 

DO  850  K=1f99 
ST ( IND  f 7 ) =K 

IF  < ST ( IND . 6 ) .EQ.  DICK))  GOTO-  864 
IF  < ST ( IND f 6 ) .EQ.  -DI (K) ) GOTO  500 


0043 

0045 

0046 

0047 

0048 

0049 

0050 

0051 

0052 

0053 

0054 

0055 


850  IF  < D I ( K ) .EQ.  0)  GOTO  860 
C RECORD  DOES  NOT  EXIST 

860  CONTINUE 

DO  886  J=3  f 6 

886  READ  ( 8 ' J +163 ) < MOUT  <IfJ)fI  = 1f10) 
DO  890  J=1f6 

890  UR I TE ( 8 ' 334 J ) ( MOUT <IfJ)fI  = 1f10> 
NRCN0=34 
NOR EC=6 

ST  < IND  f 1 ) =4009 
RETURN 

C RECORD  EXISTS 

864  ST  < IND  f 1 ) =401 1 
LU=IFS+2 
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CORE= 

OBK  , UIOC20.203  P4001 1 .0PJ»P4001 1 .FOR/NOSN/LI : 1 

0054 

READ(LU'ST( IN0,7> ,ERR=1415> ( <OFIL( I, J> ,1=1,10) , J=1 .3) 

0057 

HO  883  J=1 , 3 

0058 

DO  883  1=1,10 

0059 

883 

MOUTLI, J)=OFIL<I, J) 

0040 

no  884  J=4 , 6 

0041 

884 

READ<8' J+156) (MOUT( I. J) , 1=1,10) 

0042 

HO  8100  J=1 » 6 

0063 

8100 

WRITE(8' J+33) (MOUT (I, J), 1=1, 10) 

0064 

NRCN0=34 

0065 

N0REC=6 

0066 

RETURN 

0047 

500 

ICON( 1 )=ICON( 1 ) + ISHFT (1,8) 

0068 

ICON ( 2 ) =0 

0069 

ICON  < 3 ) = IH51 

0070 

ICON ( 4 ) =1 

0071 

ICON( 5 ) = IFS+2 

0072 

ICON (6)=ST(I ND , 6 ) 

0073 

IC0N<7)=IC0DE<3) 

0074 

ICON  < 8 ) = 1 

0075 

ICON  <9 ) =LEQP 

0076 

ICFLG=1 

0077 

N0REC=0 

0078 

ST  ( I Nil,  1 ) = 401 1 

0079 

RETURN 

0080 

29 

IAOO=IANTiaSK,ICOnE<4>  > 

0081 

IAnD=IADD-48 

0082 

IFS=IFAC(IND) 

0083 

IF  ( I ADD  .EQ.  2)  SOTO  961 

C 

Ann  A RECORD 

0085 

no  930  J=1 ,2 

0086 

930 

READ  ( 8 ' 1 33+ J ) ( MOUT ( I , J ) , 1 = 1,10) 

0087 

DO  935  J=3 , 5 

0088 

K=J+178+3*( IFS-1 > 

0089 

935 

READ (8'K X MOUT ( I, J >,1=1,10) 

0090 

DO  940  J=6 , 9 

0091 

940 

READ<8'J+164) < MOUT (I, J), 1 = 1, 10) 

0092 

IF  (NOCHARKE Y ( IFS ) .EQ.  2)  MOUT ( 3 , 4 > =Q2Q 

0094 

IF  (NOCHARKEY < IFS)  .EQ.  4)  MOUT < 3 , 6 ) =04Q 

0096 

MOUT  (4,7)  =KE YTYPEFM  ( IFS ) 

0097 

DO  990  J=l,9 

0098 

990 

URITE(8' J+33 ) (MOUT ( I, J) , 1=1,10) 

0099 

NRCN0=34 

0100 

N0REC=9 

0101 

ST ( IND, 1 )=4010 

0102 

RETURN 

C 

DO  NOT  ADD  A RECORD 

0103 

961 

NRCN0=174 

0104 

N0REC=6 

C 

RECORD  UNLOCK  SHOULD  OCCUR  HERE 

0105 

ST ( IND , 1 > =4014 

0106 

RETURN 

0107 

30 

IFS=IFAC( IND) 

0108 

LU=IFS+2 

0109 

DO  300  J=1 , 40 

0110 

300 

L I NE'(  J ) = I CODE  ( J+3 ) 

0111 

DO  310  1=1,10 

4 
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FORTRAN  IV 

V01B-02  FRI  18-MAR-77  19122 

C0RE  = 

08N  , UIC=C20»203  P40011.0BJ: 

0112 

310 

0FIL(I,1)=IFAR(I> 

C 

ADD  A NEW  RECORD 

0113 

DO  1050  1=1,10 

0114 

DO  1050  J=2 , 3 

0115 

1050 

0FIL ( I , J ) = ADE 

0116 

READ ( 2 ' IFS , ERR= 1415)<DI(I)»I  = 1 ,100) 

0117 

DO  1055  K=1 , 99 

0118 

ST  < IND , 7 ) =K 

0119 

IF  (DICK)  .Ed.  0)  GOTO  1060 

0121 

1055 

CONTINUE 

0122 

1060 

DI < ST ( IND , 7 ) ) =ST  < IND , 6 ) 

0123 

DI ( ST ( IND , 7 ) + 1 ) =0 

0124 

WRITE  < LU ' ST  < IND , 7 > ,ERR=1 415 ) ( ( OFIL ( I » J) 

0125 

WRITE ( 2 ' IFS » ERR=1 41 5 ><DI(I),I  = 1, 100 ) 

0126 

NRCN0=174 

0127 

NOREC=6 

0128 

ST( IND, 1 ) =401 4 

0129 

ICON (1)=IC0N(1 ) +ISHFT (1,8) 

0130 

ICON ( 2 ) =0 

0131 

ICON  < 3 > = IH51 

0132 

I CON ( 4 ) =3 

0133 

ICON ( 5 > = IFS+2 

0134 

ICON  < 6 ) =ST  < IND , 6 ) 

0135 

ICON ( 7 > =LEOP 

0136 

ICFLG=1 

0137 

RETURN 

0138 

31 

IUPDEL=I  AND  < LSK  , I CODE  < 4 ) ) 

0139 

IUF'DEL=IUF'DEL-48 

0140 

IFS=IFAC(IND) 

0141 

ST ( IND , 1 ) =401 2 

0142 

IF  < IUPDEL  .EQ.  2)  GOTO  1161 

C 

UPDATE  RECORD 

0144 

NRCN0=162 

0145 

N0REC=3 

0146 

RETURN 

C 

DELETE  RECORD 

0147 

1161 

CONTINUE 

0148 

READ < 2 ' IFS , ERR= 1 4 1 5 ) < D I < I > » I = 1 , 1 00 > 

0149 

IF  ( D I < ST < I ND , 7 > + 1 ) .EG.  0)  DI(ST(IND,7: 

0151 

IF  (DI(ST(IND,7)fl)  .NE.  0)  DI(ST(IND,7; 

0153 

URITE(2'IFS,ERR=1415) <DI(I) ,1=1,100) 

0154 

NRCN0=1 74 

0155 

N0REC=6 

0156 

ST(IND,1)=4014 

0157 

ICON ( 1 ) =ICON ( 1 ) +ISHFT (1,8) 

0158 

ICON ( 2 )=0 

0159 

ICON( 3 ) =IH51 

0160 

ICON ( 4 ) =4 

0161 

ICON ( 5 ) = IFS+2 

0162 

ICON ( 6)=ST ( IND, 6) 

0163 

ICON ( 7 ) =LEOP 

0164 

ICFLG=1 

0165 

RETURN 

0166 

32 

DO  400  J=1 , 40 

0167 

400 

LINE ( J > = ICODE ( J+3 ) 

0168 

DO  410  1=1,10 

PAGE  003 


*1  ,3) 
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0169  410  OF IL  < I » 1 ) = I F AR  < I > 

0170  IFS=IFAC( IND) 

0171  READ ( 2 ' IFS . ERR=1 4 15  > (D 1(1). 1=1.1 00 ) 

0172  DO  1500  K= 1 , 99 

'0173  ST ( IND, 7 )=K 

0174  IF  (ST  ( IND » 6 ) .EQ.  DI(K) > GOTO  1510 

0176  IF  ( ST ( IND , 6 ) .EQ.  -HI < K > > GOTO  510 

0178  15 00  IF  ( DI (K)  .EQ.  0)  GOTO  530 

01B0  1510  LU=IFS+2 

0181  DO  1250  1=1 f 10 

0182  DO  1250  J=2»  3 

0183  1250  OFIL ( I » J ) =UPD 

0184  WRITE (LU' ST ( IND. 7) .ERR=1415) ( (OFIL(I. J) >1=1 >10) , J=1.3> 

0185  530  NRCN0=1 74 

0186  N0REC=6 

0187  ST ( IND» 1 ) =4014 

0188  RETURN 

0189  510  ICON (1)  = IC0N(1 ) +ISHFT (1.8) 

0190  ICON ( 2 ) =0 

0191  IC0N(3)=IH51 

0192  ICON ( 4 ) =2 

0193  IC0N(5)=IFS+2 

0194  ICON (6 )=ST ( IND , 6 ) 

0195  DO  520  J=l,40 

0196  520  ICON (J+6)=LI NE ( J > 

0197  ICON (47) =LEOP 

0198  ICFLG=1 

0199  GOTO  530 

0200  34  I=IAND(LSN,IC0DE(4> > 

0201  1=1-48 

C MODE  4 SWITCH  OUT 


0202 

IF 

(I  .EQ,  1) 

GOTO 

1470 

• 

0204 

IF 

(I  .EQ.  2) 

GOTO 

144 

0206 

IF 

(I  .EQ.  3) 

GOTO 

146 

0208 

IF 

(I  .EQ.  4) 

GOTO 

140 

0210 

IF 

(I  .EQ.  5) 

GOTO 

149 

0212  1415  NRCN0=1 1 

0213  N0REC=1 

0214  RETURN 

0215  1470  NRCNO= 1 37 

0216  N0REC=3 

0217  ST ( IND  f 1) =4002 

0218  RETURN 

0219  144  NRCNO= 1 27 

0220  N0REC=6 

0221  ST ( IND  »1)=4000 

0222  RETURN 

0223  146  NRCN0=5 

0224  N0REC=6 

0225  ST ( INDr 1 )=0004 

0226  RETURN 

0227  148  NRCN0=21 

0228  N0REC=1 

0229  ST( IND. 1 >=9999 

0230  RETURN 

0231  149  LU= IF AC ( IND ) +2 
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0232  IFS=IFAC ( IND ) 

0233  READ ( 2 ' IFS  f ERR=1415  > (DI(I)fI=1f 100 ) 


0234 

0235 

0236 
0238 
0240 

0242 

0243 

0244 

0245 

0246 

0247 

0248 

0249 

0250 

0251 

0252 

0253 

0254 

0255 

0256 

0257 

0258 

0259 

0260 
0261 
0262 
0263 


DO  1520  K‘-l  f 99 
ST ( INDf  7 > =K 

IF  (ST < IND f 6 ) .EG.  D I < K ) ) GOTO  1530 
IF  ( ST < IND  f 6 ) .ECl.  — D I < K > > GOTO  540 
1520  IF  (DI(K)  .EO.  0)  GOTO  550 

1530  READ(LU/ST(IND»7)fERR=1415)< (OFIL(IfJ) f 1=1 f 10 ) f J=1 f 3 ) 
DO  150  J=1 f 3 
DO  150  1=1 f 10 

150  M0UT(If J)=OFIL(Ir J) 

MOUT ( 1 f 5 ) =XMT 

DO  151  J=1 f 5 

151  URITE(8'J+33) (MOUT(IfJ) fI=1f10) 

550  NRCN0=34 

N0REC=5 

ST ( INDf 1 >=4006 
RETURN 

540  IC0N(1>  = IC0N(1H-ISHFT(1f8> 

ICON ( 2 ) =0 
ICON  < 3 ) = IH51 
ICON < 4 ) = 1 
ICON ( 5 ) =IFS+2 
ICON ( 6 > =ST ( I ND  f 6 ) 

ICON ( 7 > = ICODE  < 3 ) 

ICON ( 8 ) =2 
ICON ( 9 ) =LEOP 
ICFLG=1 
N0REC=0 


0264 

0265 

0266 


ST  < IND  f1)=4006 

RETURN 

END 


FORTRAN  IV  DIAGNOSTICS 


C WARNING  3 MSG  #092  VARIABLE  * NOCHAR ' NAME  EXCEEDS  6 CHARACTERS 
t WARNING  3 MSG  *092  VARIABLE  •KEYTYP1  NAME  EXCEEDS  6 CHARACTERS 


FOR  — CP4001  3 ERRORS.*  Of  WARNINGS:  2 

> 
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P5000 


NRCNO  = 112 
NOREC  = 7 
ST(IND.  1)  = 5001 


K = LAND 
(LSK,  ICODE(4)) 
K ■ K - 48 


ST(IND.  1) 


NRCNO  =119 
NOREC  = 3 
STdND.  1)  = 5 


ST(IND.  1) 


NRCNO  = 122 
NOREC  = 5 
STdND,  1 ) = 5 


ST(IND,  1) 


RETURN 


STdND.  1) 


STdND.  1 ) 


I * IAND 
(I.SK,  ICODE(4)) 
I = I - 48 


NRCNO  = 5 
NOREC  = 6 
STdND.  1)  = 0004 


NRCNO  = 21 
NOREC  = 1 
STdND.  1)  = 9999 


NRCNO  = 112 
NOREC  = 7 
STdND.  1)  = 5001 


NRCNO  * 11 
NOREC  * 1 


Figure  1-16.  P5000 


No 

NRCNO  = 11 

Burroughs  Corporation 


P5000(cont.) 


(return) 


ICON(l)  -- 

0 

ICON  (2) 

0 

ICOM3)  = 

"1002 

ICON  (4)  = 

"24 

IC  ON  (126) 

= "24 

ICON(127) 

= "177777 

ICFLG  - 1 
NRCNO  = 122 
NOR EC  - 5 
STdND.ll  5003 


—(return) 


Figure  1-16.  (Cont.) 
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0001  SUBROUTINE  P5000 

c 

0002  REAL*8  MOUT  f NBI  . LIB . TAB . NUltl 

0003  INTEGER  ST 

0004  COMMON  NDI . L I D . TAB . NUD f ST ( 3 . 9 > f IND 

0005  COMMON  /UOOO/  MOUT < 1 0 f 1 1 > f NRCNO f NOREC 

0006  COMMON  /CPAC/ICON ( 128 > , ICFLG 

0007  BATA  LFfLHOMEfLEOF'f IBRCSTfIHB/'12f  *24 f '177777 f *1002f  *2577/ 

0008  COMMON  /LOOP/ 1 CODE <120) f MSK  fLSK 
C 

C CARD  FORMAT  MODE  OF  OPERATION 

C 

0009  IF(ST(INDf1)  .EQ.  5000 ) GOTO  85 

0011  IF  <ST(INDf1>  .EQ.  5001)  GOTO  21 

0013  IF  (ST(INDfI)  .EQ.  5002)  GOTO  22 

0015  IF  (ST(IND.l)  .EQ.  5003)G0T0  23 

0017  IF  (ST(INDfI)  .EQ.  5004)  GOTO  24 

0019  21  K=IAND<LSKfIC0DE<4)  ) 

0020  IF  < K .EQ.  49)  GOTO  100 

0022  NRCK'0=122 

0023  N0REC=5 

0024  ST < IND. 1) =5003 

0025  RETURN 

0026  100  NRCN0=1 4 

0027  N0REC=1 

0028  ST  < INDf 1 )=5004 

0029  RETURN 

0030  24  DO  110  J=5 . 20 

0031  110  ICON < J ) =LF 

0032  DO  120  J=4.108 

0033  ICON ( J+17 ) = I CODE  < J > 

0034  ILM=IAND(MSKf ICODE( J) ) 

0035  ILL=IANB<LSKf ICODE(J) ) 

0036  KK=J+1 7 

0037  IF  (ILM  .EQ.  MSK)  GOTO  130 

0039  120  IF  (ILL  .EQ.  LSK ) GOTO  140 

0041  130  IC0N(KK)=IAND(LSKfIC0DE(KK-17) > 

0042  GOTO  150 

0043  140  ICON < KK ) -0 

0044  150  BO  160  J=KK+1f125 

0045  160  ICON < J > =0 

0046  ICON  < 1 > = 0 

0047  ICON (2)=IBRCST 

0048  ICON ( 3 ) = IHB 

0049  ICON ( 4 ) =LHOME 

0050  ICON (126) =LHOME 

0051  IC0N(127)=LE0F 

0052  ICFLG=1 

0053  NRCN0=122 

0054  N0REC=5 

0055  ST ( IND  f 1 ) =5003 

0056  RETURN 

0057  22  NRCN0= 1 22 

0058  N0REC=5 

0059  ST(INDfI) =5003 

0060  RETURN 
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IV 

V01B-02 

TUE 

C0RE=08Kf  UIC=C20f  203 

0061 

23 

I=IAND(LSK 

f ICODE  < 4 ) > 

0062 

1=1-48 

0063 

IF  <1  .EG. 

1)  GOTO 

830 

0065 

IF  (I  .EG. 

2)  GOTO 

6 

0067 

IF  (I  .EG. 

3)  GOTO 

8 

0069 

IF  (I  .EQ. 

4)  GOTO 

o 

(N 

CO 

0071 

NRCNO=l 1 

0072 

N0REC= 1 

0073 

RETURN 

0074 

830 

NRCNO=l 1 9 

0075 

N0REC=3 

0076 

ST<INDrl>= 

5002 

0077 

RETURN 

0078 

6 

NRCN0=5 

0079 

N0REC=6 

0080 

ST(INDf1)= 

0004 

0081 

RETURN 

0082 

8 

NRCN0=21 

0083 

N0REC=1 

0084 

ST  < IND » 1 ) = 

9999 

0085 

RETURN 

0086 

820 

NRCN0=1 12 

0087 

N0REC=7 

0088 

ST(INDf1)= 

5001 

0089  . 

RETURN 

0090 

85 

K=IAND(LSK 

f ICODE ( 4 ) ) 

0091 

K=K-48 

0092 

IF  (K  .EG. 

1>  GOTO 

82 

0094 

IF  (K  .EG. 

2)  GOTO 

83 

0096 

20 

NRCN0=ll 

0097 

N0REC=1 

0098 

RETURN 

0099 

82 

NRCN0= 112 

0100 

NOR EC=7 

0101 

ST(INDf1)= 

5001 

0102 

RETURN 

0103 

83 

NRCNO=l 1 9 

0104 

N0REC=3 

0105 

ST(INDf1)= 

5002 

0106 

RETURN 

0107 

END 

-77  15  S 55 ! 40  PAGE  002 

P5000 . OP  J=F'5000 . F0R/N0SN/L I ! 1 


FORTRAN  IV 


DIAGNOSTICS 


t WARNING  3 MSG  *094  NON-STANDARD  STATEMENT  ORDERING 

FOR  — CP5000  3 'ERRORS!  Of  WARNINGS!  1 

> 
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FORTRAN  IV  V01B-02 

CORE=08K»  UIC=C20.20T 


TUE  01-MAR-77  16J16S24  PAGE  001 

RBL00P  4 OB J=RDLQ0P • F0R/N0SN/LI S 1 


1 


0001 

0002 

0003 

0004 

0005 

0006 
0008 
0010 
0011 
0012 

0013 

0014 

0015 

0016 
0018 
0020 
0021 
0022 
0023 


SUBROUTINE  RBLOOP 
INTEGER  DEVST  < 6 ) 

COMMON  /M1710/DEVST 
COMMON  /LOOP/  I CODE (128) »MSK*LSK 
90  I=M0D ( DEVST ( 3 ) > 2 ) 

IF  (I  ,EO.  1>  GOTO  120 
IF  (I  .EO.  -1)  GOTO  120 
DO  110  I— 1 f 10 
110  CONTINUE 
GOTO  90 

120  DO  130  J=1 » 129 
no  140  1 = 1 1 3 


1 


J 


140  CONTINUE 

IF  <J  ,EQ.  1)  K=0EVST<1> 

IF  (J  .GT.  1)  ICOnE<J-l)=nEVST(l) 
130  CONTINUE 
nEVST<5>=0 
RETURN 
ENB 


J i 


J 


Burroughs  Corporation 


FORTRAN 

IV 

V01B-02  TUE 

CORE=08K 

» UIC=C20f203 

0001 

SUBROUTINE  UIRL00F  C 1 1 ST  > 

0002 

INTEGER  BEVST ( 6 ) 

0003 

COMMON  /Ml 71 0/  BEVST 

0004 

COMMON  /LOOP/ 1 CODE  < 1 28 ) . 1 

0005 

IF  ( 1 1ST  .EG.  0)  GOTO  40 

0007 

50 

I=M0B(DEVST<4) .2) 

0008 

IF  <1  .EG.  1)  GOTO  40 

0010 

IF  <1  .EG.  -1)  GOTO  40 

0012 

BO  60  1=1.10 

0013 

60 

CONTINUE 

0014 

GOTO  50 

0015 

40 

BO  70  J=1 . 128 

0016 

DO  80  1=1.3 

0017 

80 

CONTINUE 

0018 

70 

BEVST ( 2 ) = ICOBE  < J) 

0019 

BEVST  < 6 ) =0 

0020 

RETURN 

0021 

ENB 

AR-77  16J17!24  PAGE  001 

URL OOF . 0DJ=WRL00P . F0R/N0SN/L 1 5 1 
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r 


Figure  1-19.  (Cont.) 


Burroughs  Corporation 


FORTRAN 

IV 

V01B-02  FRI  18- MAR-??  19 

CORE  = 0SI 

K,  ij  I C-C  20,  28  I H 

0801 

SUBROUTINE  HST 

8002 

REAL+3  MOOT,  OFIL,  XMT,  IFAR, UPD 

8083 

INTEGER  ST. 01 

0084 

COMMON  /LOOP/ 1 CODE < 128, V MSK, LSK 

8805 

COMMON  /U00O/MQUT < 18,  11.',  NRCNO,  NOREC 

'8806 

COMMON  /DSK/I1.  12,  13,  14,  15,  16,  116 

008? 

DIMENSION  OFILC10,  3),DH  1 0 0 ? 

0808 

DIMENSION  LINE*  40),  I FAR  CIO? 

0009 

EQUIVALENCE  CLINE,  I FAR,’ 

8010 

DATA  XMT, UPD/'PRS  XN IT',' UPDATED  '/ 

0011 

DATA  I SPC/ " 120248/ 

0012 

IF  C I CODE C 4 ? EG  1?  GOTO  21 

0814 

IF  C I CODE  c 4 ? EQ  2)  GOTO  22 

8816 

IF  (1C0DEC4?  EQ.  3?  GOTO  23 

0018 

IF  CIC0DEC4?  EG  4?  GOTO  -24 

0020 

NOR£C=0 

8821 

RETURN 

8022 

21 

ICODEc2>=0 

0023 

I CODE  C 3 >= I AND  C LSK,  I CODEC??  ?+ISHFT<5,  ! 

0024 

I F S = I C 0 0 E < 5 • - 2 

8025 

READ  C 2"  I F S , E R R = 9 9 ? C D I C I ? , 1 = 1,100? 

8826 

DO  550  K = l,  108 

0027 

KK  = K 

0028 

IF  CIC0DEC6?  EQ.  DICK??  GOTO  560 

0030 

550 

CONTINUE 

0031 

568 

LU= I CODECS? 

0032 

READCLU' KK, £PR  = 99 ? C C OF  I L C I , J?,  1=1*18 

8033 

DO  532  J=l, 3 

8034 

DO  582  1=1,18 

8835 

582 

MOUTCI,  J ? = OF  I L C I,  J? 

8036 

DO  682  J=l, 3 

8037 

632 

NR  I TECS' J + 33?  CMOUTC  I, J?,  1 = 1,18? 

0030 

IF  CIC0DEC8?  . EQ.  2?  GOTO  38 

0048 

DO  658  J=4, 6 

0041 

READ'S'  J + 156?  CNOUT  c I, J ?,  1=1,  18? 

8042 

650 

W R I T E C 8 ' ,1  + 33?  CMOUTC  I,  ,'?,  1=1,  10? 

8043 

NRCN0=34 

0044 

N0REC=6 

8045 

RETURN 

0846 

38 

NRCN0=34 

004? 

N 0 R E C = 3 

0048 

RE  TURN 

0849 

99 

N R C N 0 = 1 1 

0050 

N0REC=1 

0051 

RETURN 

8052 

22 

DO  408  ,1  = 1,  40 

8053 

400 

L I HE  C J ? = I CODE  C ,f  + 6 ? 

8854 

I FS= I CODE  C 5 ?-2 

0855 

READ C 2"  IFS. £ RR  = 99 ? CD I C I ? , 1=1,180? 

8856 

DO  40l  K=l, 108 

005? 

KK  = K 

8058 

IF  CIC0DEC6?  EG  D I C K ? ? GOTO  482 

0060 

401 

CONTINUE 

0061 

402 

DO  418  1=1,10 

0062 

410 

OF  I L C 1 , 1 > = I FAR  c I ? 

0063 

DO  1258  1=1,  10  - 

PAGt  001 
N0SN/LI  : 1 


8 ? 


,r  = l, 3; 
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FORTRAN  IV  V01B-02 

C0RE=08K,  U I C = C 20/ 20  J 


FRI  18-MAR-77 


1 9.27:27  PAGt  0O2 

HST  0BJ=HST. FOR/NOSNPLl  1 


0064 

0065 

0066 
006? 
0068 
006? 

0070 

0071 

0072 

0073 

0074 

0076 

0077 
8078 
0079 
0088 
0081 
0882 

0083  - 

0084 

0085 

0086 
0088 

0090 

0091 
0093 

0095 

0096 

0097 

0098 


1250 


23 


1055 

1060 


24 


1070 

1075 


PO  1250  J =2/ 3 
OF  I LSI.  J)=UPD 
IU  = I CGPES5) 

URITESLU'  KK,  ERR=99?  < (OF  Il.(  I,  J>,  1=1.  10>,  J = l,  3.' 

NOREC=0 

RETURN 

IFS=  IC0DES5  >-2 

READS2'  IFS,  ERR  = 99)SDI<.I  >,  1 = 1,  100) 

DO  1055  K=l, 9? 

KK=K 

IF  (DKK)  EO  0>  GOTO  1060 
CONTINUE 

DI<.KK?  = -IC0PEC6) 

D I SKK+l ) =0 

WRITES2'  IFS,  ERR=99><.DIU>,  1 = 1.  100? 

NOREC=0 

RETURN 

IFS=IC0PEC5>-2 

READC2'  IFS,  ERR  = ?9><.DICI),  1=1,  100? 

00  1070  K = l,.100 
KK  = K 

IF  ( I CODE  S 6 > EO 
IF  (IC0DEs6>  . EO. 

CONTINUE 

IF  (OUKK+l)  . EO.  0>  PIC  KK  > =0 
IF  (DUKKH)  ME.  '0>  PHKK>  = ISPC 
URITEC2'  IFS,  ERR  = 99)CDI<:I>,  1 = 1,  100;' 

NOREC=0 
RETURN 
END 


DISK?) GOTO  1075 
-DICK?)  GOTO  1075 


0001  SUBROUTINE  HST 

0002  REALMS  MOUT , OFIL , XMT , IFAR . UF'D 

0003  INTEGER  ST.DI 

0004  COMMON  /LOOP/ 1 CODE  < 128  > » MSK » LSK 

0005  COMMON  /UOOO/MOUT  ( 10 . 1 1 ) , NRCNO.f  NOREC 

0006  COMMON  /DSK/I 1 , 12 , 13 , 14 , 15 , 16 , I 16 

0007  DIMENSION  OF IL ( 10 » 3 > , DI < 100 ) 

0008  DIMENSION  L INE < 40 ) , IFAR ( 10 ) 

0009  EQUIVALENCE  (LINE. IFAR) 

0010  DATA  XMT.UPD/'PRS  XMIT UPDATED  V 

0011  DATA  ISPC/ * 120240/ 

0012  IF  < ICOPE  ( 4 > .EQ.  1)  GOTO  21 

0014  IF  < I CODE ( 4 ) .EQ.  2)  GOTO  22 

0016  IF  < ICODE < 4 ) .EQ.  3)  GOTO  23 

0018  IF  ( ICODE < 4 ) .EQ.  4)  GOTO  24 

0020  NOREC-O 

0021  RETURN 

0022  21  ICODE (2 ) =0 

0023  ICODE ( 3 ) = 1 AND ( LSK  , ICODE ( 7 ) >+ISHFT(l,8> 

0024  IFS=IC0DE<5>-2 

0025  READ(2'IFS,ERR=99> (DI(I) .1=1,100) 

0026  DO  550  K=l,100 

0027  KK=K 

0028  IF  ( ICODE ( 6 ) .EQ.  DI(K) ) GOTO  560 

0030  550  CONTINUE 

0031  560  LU=ICODE ( 5 > 

0032  READ(LU'KK,ERR=99)((0FIL(I, J> , 1=1 ,10) r J=1 r3) 

0033  DO  582  J=1.3 

0034  DO  582  1=1,10 

0035  582  MOUT  < I , J ) =OFIL ( I , J ) 

0036  DO  682  J=l,3 

0037  682  WRITE < 8 ' J+33 ) ( MOUT (I»J), 1 = 1,10) 

0038  IF  ( ICODE < 8 ) .EQ.  2)  GOTO  30 

0040  DO  650  J=4 ,6 

0041  READIB' J+156) (MOUT ( I , J) , 1=1 , 10 > 

0042  650  WRITE < 8 ' J+33 ) < MOUT (I, J), 1 = 1, 10) 

0043  NRCN0=34 

0044  N0REC=6 

0045  RETURN 

0046  30  NRCN0=34 

0047  N0REC=3 

0048  RETURN 

0049  99  NRCN0=1 1 

0050  N0REC=1 

0051  RETURN 

0052  22  DO  400  J=l,40 

0053  400  LINE( J)=ICODE ( J+6) 

0054  IFS=ICODE  < 5 > -2 

0055  READ(2'IFS,ERR=99) <DI(I> ,1=1,100) 

0056  DO  401  K=1 , 100 

0057  KK=K 

0058  IF  ( IC0DE(6)  .EQ.  DI(K)>  GOTO  402 

0060  401  CONTINUE 

0061  402  DO  410  1=1,10 

0062  410  OFIL ( 1,1 > = IFAR < I ) 

0063  DO  1250  1=1,10 
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0064 

DCJ  1250  J=2»  3 

0065 

1250 

OFILdi  J)=UPD 

0066 

LU=IG0DE<5> 

0067 

WRITE < LU' KK » ERR=99) ( (OFIL < I > J > > 1 = 1 » 

0068 

N0REC=0 

0069 

RETURN 

0070 

23 

IFS=ICODE  ( 5 ) --2 

0071 

READ ( 2 ' IFS  > ERR=99 )(DI(I)»I=1> 100  > 

0072 

DO  1055  K=l>99 

0073 

KK-K 

0074 

IF  (DI(K)  .EQ.  0)  GOTO  1060 

0076 

1055 

CONTINUE 

0077 

1060 

DI(KK)=-IC0DE(6) 

0078 

DKKKtl  >=0 

0079 

WRITE  ( 2 ' IFS  > ERR=99 )(DI(I)>I— 1> 100 ) 

0080 

N0REC=0 

00B1 

RETURN 

0082 

24 

IFScIC0DE<5>-2 

0083 

READ (2 ' IFS  t ERR=99 )<DI(I)»I=1. 100  > 

0084 

DO  1070  K=1 » 100 

0085 

KK=K 

0086 

IF  ( ICODE  ( 6 > .ECI.  DI<K))GOTO  1075 

0088 

IF  ( IC0DET6)  .EQ.  -DI<K>>  GOTO  1075 

0090 

1070 

CONTINUE 

0091 

1075 

IF  <DI (KK+1 > .EQ.  0)  DI  ( KK  > =0 

0093 

IF  <DI (KK+1 > .NE.  0)  DI ( KK > = ISPC  , 

0095 

WRITE <2' IFS. ERR=99) <DI(I) >1=1.100) 

0096 

N0REC=0 

0097 

RETURN 

0098 

END 

> 
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EDI  MSG. DAT 
C00080  LINES  READ  INI 
CF'AGE  03 
♦BLOCK  OFF 

♦T 

♦LI 

THIS  IS  THE  ESM  - (EXPLORATORY  SYSCON  MODEL) 

ENTER  USERCODE  PLEASE 
ENTER  PASSWORD  PLEASE 

YOU  ARE  NOW  LOGGED  IN  - (TO  LOGOUT.  ENTER  ’DS') 

PLEASE  SELECT  ONE  MODE  OF  OPERATION 
1 • CRT  TO  CRT 
2. SYSTEM  INQUIRY 
3. SYSTEM  CONTROL 

4.  FILE  ACCESS 

5.  CARD  FORMAT 

♦INVALID  ENTRY^  - PLEASE  TRY  AGAIN  (OR  ENTER  DS  TO  LOGOUT) 

ENTER  DEST  CRT  NODE  DESIGNATOR(ND ) - 4 FOR  LP*2.  8 FOR  LF'*3 
IF  NOT  KNOWN  ENTER  " NO I ■ 

PLEASE  TYPE  IN  MESSAGE  AND  TRANSMIT 
PLEASE  SELECT  ONE  MODE  OF  OPERATION 

1.  NEW  MESSAGE  TO  SAME  CRT 

2.  NEW  MESSAGE  TO  ANOTHER  CRT 

3.  LOGOUT 

A.  NEW  MODE  OF  OPERATION. 

020  NOT  YET  IMPLEMENTED -PL EASE  RESELECT 
YOU  ARE  LOGGED  OUT  FROM  ESM 
PLEASE  SELECT  TYPE  OF  SYSTEM  INFORMATION 

1.  NETWORK  DEVICE  INFORMATION 

2.  LID/FAD  CONVERSION  TABLE  (LID'S  1-100) 

3.  LID/FAD  CONVERSION  TABLE  (LID'S  101-254) 

4.  WORKPAGE  PARAMETERS  OF  NODE. 

PLEASE  ENTER  NODE  DESIGNATOR  (ND). 

IF  ND  IS  NOT  KNOWN,  ENTER  NDI 

FOR  NETWORK  DEVICE  INFORMATION. 

PLEASE  SELECT  ONE  OF  THE  FOLLOWING  1 

1.  NEW  SYSTEM  INQUIRY. 

2.  LOGOUT. 

3.  ANOTHER  MODE  OF  OPERATION. 

MSG  TO  CRT  ND=  8 

PLEASE  SELECT  ONE  MODE  OF  OPERATION 

1.  NEW  MESSAGE  TO  SAME  CRT 

2.  NEW  MESSAGE  TO  ANOTHER  CRT 

3.  LOGOUT 

4.  NEW  MODE  OF  OPERATION. 

GATE  2 2 1 6 1 3 10  2 1 

GATE  3 3 2 7 3 4 11  1 4 

NOTE:  NT  IS  NODE  TYPE  ND  IS  NODE  DESIGNATOR.  RDA  IS  FUNCTIONAL  ADDRESS 
AND  UTD  IS  WRITE  TOKEN  DESTINATION. 

PRESS  ■ T 1 KEY  FOR  NEXT  INSTRUCTION. 

LID/FAD  CONVERSION  TABLE 
11122224321 
0 
0 
0 
0 
0 

0 0 0 0 0 0 0 
0 
0 
0 


I 

i 


I 


0 

0 

00000000000001 
NODE  WORKF'AGE  PARAMETERS 

CRT  NODE  HAS  DESIGNATOR  8 RDA  4 IN  LOOP  3 

ALTERNATE  GATEWAY  FUNCTIONAL  ADDRESSES  . ...  It  2 

MAXIMUM  INPU1  QUEUE  SIZE  (TO  EXTERNAL)  8 

MAXIMUM  OUTPUT  QUEUE  SIZE  (TO  DITSTREAM ) ....  1 
MAXIMUM  PACKET  XMISSIONS  BEFORE  ERROR  MESSAGE  . . 8 


TIMEOUT  FOR  WRITE  TOKEN  REGERER AT  I ON .12 

TIMEOUT  FOR  PACKET  RETRANSMISSION  II 

NUMBER  OF  NODES  IN  SYSTEM 11 

NUMBER  OF  NODES  IN  LOOP 4 

PRESS  'T*  KEY  FOR  NEXT  INSTRUCTION 


PLEASE  SELECT  TYPE  OF  SYSTEM  PARAMETERS 
TO  BE  CHANGED. 

1.  NETWORK  DEVICE  PARAMETERS. 

2.  LID/FAD  CONVERSION  TABLE  (LID'S  1-100) 

3.  LID/FAD  CONVERSION  TABLE  (LID'S  101-254) 

4.  WORKPAGE  PARAMETERS.  (NOT  YET  IMPLEMENTED  IN  CIE  MEMORY) 
PLEASE  SELECT  NODE  DESIGNATOR  (ND)  * ENTER 

IF  ND  IS  NOT  KNOWN.  ENTER  * NDI ‘ FOR  DISPLAY. 

PLEASE  SELECT  PARAMETER  TO  BE  CHANGED.  FOLLOWED 
B,'  THE  NEW  VALUE.  (FORMAT  I1.I3.5X) 

1.  NODE  DESIGNATOR  — NOT  IMPLEMENTED 

2.  FUNCTIONAL  ADDRESS. 

3.  WRITE  TOKEN  DESTINATION. 

4.  NO  CHANGE. 

PLEASE  ENTER  LID  FOLLOWED  BY  NEW  FAD  (FORMAT  14.14). 

FOR  TABLE  DISPLAY  ENTER  ‘LID*. 

PLEASE  ENTER  LID  FOLLOWED  Br  NEl  FAD 
(FORMAT  T4.I4) 

FOR  TABLE  PAGE  DISPLAY.  ENTER  • TAB 1 . 

PLEASE  ENTER  ONE  OF  THE  FOLLOWING  FOLLOWED  BY  NEW 
VALUE  (FORMAT  II. A7 ) . FOR  NODE  WKPG  DISPLAY,  ENTER  * NNWD* . 

1.  ALTERNATE  GATEWAY  FUNCTIONAL  ADDRESS  . 

2.  ALTERNATE  GATEWAY  FUNCTIONAL  ADDRESS  . 

3.  MAXIMUM  INPUT  QUEUE  SIZE  (EXTERNAL). 

4.  MAXIMUM  OUTPUT  QUEUE  SIZE  (BITSTREAM). 

5.  MAXIMUM  PACKET  XMISSIONS  BEFORE  ERROR  MESSAGE. 

6.  TIMEOUT  FOR  WRITE  TOKEN  REGENERATION. 

7.  TIMEOUT  FOR  PACKET  RETRANSMISSION. 

8.  NUMBER  OF  NODES  IN  SYSTEM. 

9.  NUMBER  OF  NODES  IN  LOOP. 

100  PLEASE  SELECT  ONE  OF  THE  FOLLOWING! 

101  1.  SYSTEM  UPDATE  OF  CHANGE 

102  2. LOOP  UPDATE  OF  CHANGE. 

103  3.  NO  ACTION. 

PLEASE  SELECT  ONE  OF  THE  FOLLOWING'. 

1.  NEW  SYSTEM  CONTROL  OE  SAME  TYPE 

2.  NEW  SYSTEM  CONTROL  OF  DIFFERENT  TYPE 

3.  LOGOUT. 

4.  ANOTHER  MODE  OF  OPERATION. 

DO  YOU  WISH  TO  EXECUTE  AN  ESM 

DEMONSTRATION  PROGRAM? 

1.  YES 

2.  NO 

PLEASE  SELECT  PROGRAM  TO  BE  EXECUTED. 

USE  CRT  AS  AN  I/O  DEVICE  FOR  THE  PROGRAM. 

1.  CRT  BROADCAST. 
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2.  RECORD  MOVE . 

3.  INTERPROCESS  COMMUNICATION. -ABORT  USRLNG,  RUN  PROC 


YOUR  CRT  WILL  ACT  AS  A USER  TERMINAL. 

IT  WILL  ATTACH  TO  A HOST  COMPUTER.  PLEASE  ADHERE 
TO  STANDARD  MCR  AND  UTILITIES  CONTROL  FORMATS.  PRESS  XMIT 
PLEASE  SELECT  ONE  OF  THE  FOLLOWING: 

1.  NEW  CARD  FORMAT  RUN. 

2.  NEW  MODE  OF  OPERATION. 

3.  LOGOUT. 

4.  NEW  DEMO  PROGRAM. 

PLEASE  SELECT  FILE  TO  BE  ACCESSED :< ONLY  *1-4  ON  DISK) 

01.  LOCATION  FILE  06.  SUBSTANDARD  CIRCUITS 

02.  CIRCUIT  DIRECTORY  07.  MESSAGE  FILE 

03.  TRUNK  DIRECTORY  08.  SUBSCRIBER  LIST 

04.  TERMINAL  DIRECTORY  09.  INSTALLATION  LIST 

05.  SATELLITE  DIRECTORY  10.  TRAFFIC  REPORT  FILE 

A RECORD  OF  THE  FILE  YOU  HAVE  SELECTED 

HAS  THE  FOLLOWING  FORMAT.' 

THE  KEY  HAS  A 
CHARACTER  CODE  IN  FORM 
DO  YOU  WISH  TO  MODIFY  THIS  FILE? 

1.  YES. 

2.  NO. 

THE  2 BYTE  ALPHANUMERIC  LOCATION  KEY  OF  THE  CIRCUIT  OR 
TRUNK  DIRECTORY  FILES  MAY  BE  USED  AS  A KEY  TO  CROSS- 
REFERENCE  THE  TERMINAL  DIRECTORY  FILE.  DO  YOU  WISH 
TO  CROSS-REFERENCE? 

1.  YES. 

2.  NO. 

PLEASE  ENTER  ONE  OF  THE  ABOVE  INTEGER  VALUES  ON  CRT  DISPLAY. 
THE  2 BYTE  ALPHANUMERIC  LOCATION  KEY  OF  THE  TERMINAL 
DIRECTORY  FILE  MAY  BE  USED  AS  A KEY  TO  CROSS-REFERENCE 
THE  CIRCUIT  DIRECTORY  AND/OR  TRUNK  DIRECTORY  FILES. 

PLEASE  SELECT  MODE  OF  ACCESS. 

1.  NO  CROSS-REFERENCE. 

2.  CROSS-REFERENCE  CIRCUIT  DIRECTORY. 

3.  CROSS-REFERENCE  TRUNK  DIRECTORY. 

4.  CROSS-REFERENCE  BOTH. 

PLEASE  ENTER  ONE  OF  THE  ABOVE  INTEGER  VALUES  ON  CRT  DISPLAY. 
PLEASE  ENTER  ACCESS  KEY. 

PLEASE  ENTER  KEY  OF  RECORD  TO  BE  MODIFIED 
RECORD  MAY  BE  LOCKED.  *NOT  YET  IMPLEMENTED* 

FOR  THIS  RECORD  PLEASE  SELECT  TYPE  OF  DESIRED  CHANGE 

1.  UPDATE. 

2.  DELETE. 

MAKE  ANY  CHANGES  YOU  WISH  USING  CRT  KEYBOARD. 

WHEN  CHANGES  ARE  COMPLETE.  PRESS  XMIT  KEY. 

ENTER  UPDATED  RECORD  ON  FIRST  LINE  OF  CRT 
THE  RECORD  DOES  NOT  EXIST.  DO  YOU  WISH 
TO  ADD  A RECORD  TO  THE  FILE? 

1.  YES 

2.  NO 
KEY  IS 

CHARACTERS  OF  TYPE 

ENTER  THE  RECORD  ACCORDING  TO  THF  ABOVE  FORMAT. 

WHEN  RECORD  IS  COMPLETE.  PRESS  XMIT  KEY. 

ENTER  NEW  RECORD  ON  FIRST  LINE  OF  CRT. 

**  MODIFICATION  COMPLETE  ** 
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PLEASE  SELECT  ONE  OF  THE  FOLLOWING! 

1.  NEW  RECORD  OF  FILE. 

2.  NEW  FILE. 

3.  NEW  MODE  OF  OPERATION. 

4.  LOGOUT  5.  DISPLAY  SAME  RECORD. 

1000  RECORDS  FACH  0 DYTES  LONG 
FACILITY  DESCRIPTION E 2 ) -KEY 
DESCRIPTIVE  INFOE  6 ) . 

LOCAT I ON  < 2 > KEY 

TYPE  OPERATIONE 1 > .TYPE  SERVE  1 >. SUtfSCRTB . RT.E2).M0D  RTE21.TECH  SPEC (2). 
COMMER  CO E 4 ) . DCA  AREA E 1 ). AVAIL ABIL TTY E 1 > » AGENCY  C0DEE2). 

LOCATION ( 2 > -KEY 

BANDWIDTHE3) .CHAN  NO ( 1 > , ROUTE  N0<2). 

DCA  AREA ( 1 ) .AVAIL E 1 ) . CAF'AC  ITY  E 2 > . TRNK  MI (2) . SUPERGROUP E 2 > . 

TERM  EOUIF’  E 2 > -KEY 

OTHER  TERM  EQUIP E 2 > r LOCATION E 2 >. -KEY  FOR  CR, 

TRUNK  INF0E2) .CIRCUIT  INF0E2). 

192  NAME/CODE  < 4 ) -KEY 

193  CONDITION (2)  .CAF'ACITY(2>  . 

194  POWER ( 2 ) . BANDWIDTH  < 2 ) » AUTHORIZAT I ON ( 2 ) . 

195  LOCAT I ON  < 2 ) -KEY 

196  TYPE  OP  ( 1 ) . TYP  SERVED.  SUP  RT  E 2 ) . MOD  RTE2)  .TECH  SF'EC  E 2 > . 

197  COMM  CO ( 4 ) . DCA  AREA ( 1 ). AVAIL E 1 ). AGENCY  CODE E 2 ) .CIRC  N0E2). 

198  SOURCE  CODE/DEST  CODE  E 4 ) -KEY 

199  LENGTH E 2 ) . CLASS E 2 ) . SEG  NOE  1). NO  ADD  SEGMENTSE1), 

200  MESSAGE E 40). 

201  AGENCY  CODEE 21-KEY 

202  NAME  E 4 ) , AUTHOR;  1 7 AT  I ON  E 2 ) > 

203  DCA  AREAE 1 ) .LOCATION  *E1> 

204  AGENCY  CODEE 2) -KEY 

205  NAME E 6. '.LOCAT ION  »E 1 ) » DCA  AREAE 1). 

206  AUTH  CIVE2J.AUTH  MIL E 2 >. BRANCH . 

207  50  RECORDS  EACH  84  BYTES  LONG 

208  SEGMENT  NOE  2) -KEY 

209  LENGTH  E 2 ) . REP  ORT  E 80 1 , 

THE  RECORD  DOES  NOT  EXIST.  PRESS  TRANSMIT  PLEASE. 

*ED> 

EDI  — DEVICE  FULL 
CEXIT3 
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EDI  JUNK 

[CREATING  NEW  FILE] 
INPUT 

•SIZE  50 
SKILL 

EDI > INFORM . HAT 
C00050  LINES  READ  IN] 
CPA6E  0] 

♦BLOCK  OFF 

♦ T 
♦LI 


LOOP  *1 

NT  ND  RDA 

CRT 

HOST  1 1 

GATE  2 2 

GATE  3 3 

NOTE:  NT  IS  NODE  TYPE 
AND  WTP  IS  WRITE  TOKEN 
PRESS  ’T*  KEY  FOR  NEXT 

LOCAL  LOOP 
LOOP  #1 

NT  ND  FAD 

CRT 

HOST  1 1 

6ATE  2 2 

GATE  3 3 

NOTE:  NT  IS  NODE  TYPE 
AND  WTD  IS  WRITE  TOKEN 
PRESS  *T*  KEY  FOR  NEXT 

LOCAL  LOOP 
LOOP  #1 

NT  ND  FAD 

CRT 

H08T  1 1 

GATE  2 2 

GATE  3 3 

NOTE?  NT  IS  NODE  TYPE 
AND  WTD  IS  WRITE  TOKEN 
PRESS  * T * KEY  FOR  NEXT 

LOCAL  LOOP 
LOOP  *1 

NT  ND  FAD 

CRT 

HOST  1 1 

GATE  2 2 

GATE  3 3 

NOTE:  NT  IS  NODE  TYPE 
AND  WTD  IS  WRITE  TOKEN 
PRESS  *T*  KEY  FOR  NEXT 


NETWORK  DEVICE  INFORMATION 
LOCAL  LOOP 
LOOP  *2 

0 ND  RDA  WTD 


LOOP  *2  LOOP  #3 

WTD  ND  RDA  WTD  ND  RDA 

— 4 4 2 8 4 

3 5 2 1 9 3 

16  1 3 10  2 

2 7 3 4 11  1 

ND  IS  NODE  DESIGNATOR » RDA  IS  FUNCTIONAL  ADDRESS 
DESTINATION. 

INSTRUCTION. 

NETWORK  DEVICE  INFORMATION 

LOOP  *2  LOOP  #3 

WTD  ND  FAD  WTD  ND  FAD 

“ 4 4 3 8 4 

2 5 2 4 9 3 

3 6 1 2 10  1 

1731  11  2 

ND  IS  NODE  DESIGNATOR » FAD  IS  FUNCTIONAL  ADDRESS 
DESTINATION. 

INSTRUCTION. 

NETWORK  DEVICE  INFORMATION 


H08T 

GATE 

GATE 


LOOP  #2 
FAD 
4 
2 
1 
3 


LOOP  #3 
FAD 
4 
3 
1 
2 


ND  IS  NODE  DESIGNATOR.  FAD  IS  FUNCTIONAL  ADDRESS 
DESTINATION. 

INSTRUCTION. 

NETWORK  DEVICE  INFORMATION 


LOOP  #2 
FAD 
4 
2 
1 
3 


LOOP  *3 
FAD 
4 
3 
1 
2 


ND  16  NODE  DESIGNATOR.  FAD  IS  FUNCTIONAL  ADDRESS 
DESTINATION. 

INSTRUCTION. 
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NETUORK 

DEVICE  INFORMATION 

LOCAL  LOOP 

LOOP  *1 

LOOP  #2 

LOOP  #3 

NT 

ND  FAD 

UTD 

ND 

FAD 

UTD 

ND 

FAD 

CRT 

— 

— 

4 

4 

3 

8 

4 

HOST 

1 1 

2 

5 

2 

4 

9 

3 

DATE 

2 2 

3 

6 

1 

2 

10 

1 

GATE 

3 3 

1 

7 

3 

1 

11 

2 

note: 

NT  IS  NODE  TYPE 

ND  IS 

NODE 

DESIGNATOR. 

FAD  IS 

FUNCTIONAL 

ADDRESS 

AND  UTD  IS  URITE  TOKEN 

DESTINATION 

. 

PRESS 

•T*  key  for  next 

INSTRUCTION 

• 

NETUORK 

DEVICE  INFORMATION 

LOCAL  LOOP 

LOOP  #1 

LOOP  *2 

LOOP  #3 

NT 

ND  FAD 

UTD 

ND 

FAD 

UTD 

ND 

FAD 

CRT 

— 

— 

4 

4 

3 

8 

4 

HOST 

1 1 

2 

5 

2 

4 

9 

3 

GATE 

2 2 

3 

& 

1 

2 

10 

1 

GATE 

3 3 

1 

7 

3 

1 

11 

2 

note: 

NT  IS  NODE  TYPE 

ND  IS 

NODE 

DESIGNATOR. 

FAD  IS 

FUNCTIONAL 

ADDRESS 

AND  UTD  IS  URITE  TOKEN 

DESTINATION 

PRESS 

•T*  KEY  FOR  NEXT 

INSTRUCTION 

• 

NETUORK 

DEVICE  INFORMATION 

LOCAL  LOOP 

LOOP  *1 

LOOP  *2 

LOOP  #3 

NT 

ND  FAD 

UTD 

ND 

FAD 

UTD 

ND 

FAD 

CRT 

— 

— 

4 

4 

3 

8 

4 

HOST 

1 1 

2 

5 

2 

4 

9 

3 

GATE 

2 2 

3 

& 

1 

2 

10 

1 

GATE 

3 3 

1 

7 

3 

1 

11 

2 

note: 

NT  IS  NODE  TYPE 

ND  IS 

NODE 

DESIGNATOR. 

FAD  IS 

FUNCTIONAL 

ADDRESS 

AND  UTD  IS  URITE  TOKEN 

DESTINATION 

, 

PRESS 

•T"  KEY  FOR  NEXT 

INSTRUCTION 

• 

NETWORK 

DEVICE  INFORMATION 

LOCAL  LOOP 

LOOP  #1 

LOOP  *2 

LOOP  #3 

NT 

ND  FAD 

UTD 

ND 

FAD 

UTD 

ND 

FAD 

CRT 

— 

— 

4 

4 

3 

8 

4 

HOST 

1 1 

2 

5 

2 

4 

9 

3 

GATE 

2 2 

3 

6 

1 

2 

10 

1 

GATE 

3 3 

1 

7 

3 

1 

11 

2 

note: 

NT  IS  NODE  TYPE 

ND  IS 

NODE 

DESIGNATOR. 

FAD  IS 

FUNCTIONAL 

ADDRESS 

AND  UTD  IS  URITE  TOKEN 

DESTINATION 

• 

PRESS 

•T*  KEY  FOR  NEXT 

INSTRUCTION 

• 

NETUORK 

DEVICE  INFORMATION 

LOCAL  LOOP 

LOOP  #1 

LOOP  *2 

LOOP  *3 

NT 

ND  FAD 

UTD 

ND 

FAD 

UTD 

ND 

FAD 

CRT 

— 

— 

4 

4 

3 

8 

4 

HOST 

1 1 

2 

5 

2 

4 

9 

3 

GATE 

2 2 

3 

6 

1 

2 

10 

1 

GATE 

3 3 

1 

7 

3 

1 

11 

2 

NOTE! 

NT  IS  NODE  TYPE 

ND  IS 

NODE 

DESIGNATOR. 

FAD  IS 

FUNCTIONAL 

ADDRESS 

AND  UTD  IS  URITE  TOKEN 

DESTINATION 

, 

PRESS 

•T*  KEY  FOR  NEXT 

INSTRUCTION 

• 

UTD 

3 
1 
2 

4 


UTD 

3 

1 

2 

A 


UTD 

3 

1 

2 

■4 


UTD 

3 
1 
2 

4 


UTD 

3 
1 
2 

4 


1 
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LOCAL  LOOP 
LOOP  #1 

NT  ND  FAD 

CRT 

HOST  i 1 

GATE  2 2 

GATE  3 3 

NOTE?  NT  IS  NOPE  TYPE 
AND  WTD  IS  WRITE  TOKEN 
PRESS  *T*  KEY  FOR  NEXT 

LOCAL  LOOP 
LOOP  *1 

NT  ND  FAD 

CRT 

HOST  1 1 

DATE  2 2 

GATE  3 3 

NOTE:  NT  IS  NODE  TYPE 
AND  WTD  IS  WRITE  TOKEN 
PRESS  *T*  KEY  FOR  NEXT 

1 2 3 2 2 

0 
0 
0 
0 

1 2 3 2 2 

0 
0 
0 
0 

12  3 2 

0 
0 
0 
0 

1114 
0 
0 
0 
0 

1114 
0 
0 
0 
0 

1114 
0 
0 
0 
0 


NETWORK  DEVICE  INFORMATION 

LOOP  #2  LOOP  *3 

WTD  ND  FAD  WTD  ND  FAD  WTD 

— 4 4 3 8 4 3 

2 5 2 4 9 3 1 

3 6 1 2 10  1 2 

1 7 3 1 11  2 4 

ND  IS  NODE  DESIGNATOR.  FAD  IS  FUNCTIONAL  ADDRESS 
DESTINATION. 

INSTRUCTION. 

NETWORK  DEVICE  INFORMATION 


WTD 


ND 

4 

5 

6 

7 


LOOP  *2 
FAD 
4 
2 
1 
3 


WTD 

3 


ND 

8 

9 

11 


LOOP  *3 
FAD 

4 

3 

2 

2 
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2 

3 A 1 10 

1 

ND  IS  NODE  DESIGNATOR.  FAD  IS  FUNCTIONAL  ADDRESS 
DESTINATION. 

INSTRUCTION. 

LID/FAD  CONVERSION  TABLE 
2 2 3 3 3 3 


LID/FAD  CONVERSION  TABLE 
3 3 3 3 


WTD 

3 

1 


LID/FAD  CONVERSION  TABLE 
2 2 3 3 3 3 


LID/FAD  CONVERSION  TABLE 
3 1 3 3 3 3 


LID/FAD  CONVERSION  TABLE 
3 1 3 3 3 3 


LID/FAD  CONVERSION  TABLE 
3 1 3 3 3 3 
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LID/FAD  CONVERSION  TABLE 
11142313333 
0 
0 
0 
0 

LID/FAD  CONVERSION  TABLE 
1122224321 


LID/FAD  CONVERSION  TABLE 
11122224321 

0 

0 

0 

0 

• LID/FAD  CONVERSION  TABLE 

11122224321 
0 
0 
0 
0 


LID/FAD  CONVERSION  TABLE 
11122224321 


p 


Burroughs  Corporation 


000000000000 
NODE  W0RKPAGE  PARAMETERS 
MOST  NODE  HAS  DESIGNATOR  1 RDA 

ALTERNATE  GATEWAY  FUNCTIONAL  ADDRESSES  .... 


1 IN  LOOP 


1-200 


MAXIMUM  INPUT  QUEUE  SIZE  (TO  EXTERNAL)  4 

MAXIMUM  OUTPUT  OUEUE  SIZE  (TO  BITSTREAM)  ....  1 
MAXIMUM  PACKET  XMISSIONS  BEFORE  ERROR  MESSAGE  . . 6 

TIMEOUT  FOR  WRITE  TOKEN  REGENERATION  4 

TIMEOUT  FOR  PACKET  RETRANSMISSION  41 

NUMBER  OF  NOBES  IN  SYSTEM 11 

NUMBER  OF  NODES  IN  LOOP 3 

PRESS  * T • KEY  FOR  NEXT  INSTRUCTION 

NODE  WORKFAGE  PARAMETERS 

GATE#?  NODE  HAS  DESIGNATOR  2 RDA  2 IN  LOOP 

ALTERNATE  GATEWAY  FUNCTIONAL  ADDRESSES  . . . . 2,  3 

MAXIMUM  INPUT  QUEUE  SIZE  (TO  EXTERNAL)  10 

MAXIMUM  OUTPUT  QUEUE  SIZE  (TO  BITSTREAM)  ....  1 

MAXIMUM  PACKET  XMISSIONS  BEFORE  MSG  TERM NA 

TIMEOUT  FOR  WRITE  TOKEN  REGENERATION  7 

TIMEOUT  FOR  PACKET  RETRANSMISSION  NA 

NUMBER  OF  NODES  IN  SYSTEM 11 

NUMBER  OF  NODES  IN  LOOP 3 

PRESS  •T"  KEY  FOR  NEXT  INSTRUCTION 

NODE  WORKPAGE  PARAMETERS 

QATE#3  NODE  HAS  DESIGNATOR  3 RDA  3 IN  LOOP 

ALTERNATE  GATEWAY  FUNCTIONAL  ADDRESSES  . ...  2,  3 

MAXIMUM  INPUT  QUEUE  SIZE  (TO  EXTERNAL)  10 

MAXIMUM  OUTPUT  QUEUE  SIZE  (TO  BITSTREAM)  ....  1 
MAXIMUM  PACKET  XMISSIONS  BEFORE  ERROR  MESSAGE  . . NA 

TIMEOUT  FOR  WRITE  TOKEN  REGENERATION  12 

TIMEOUT  FOR  PACKET  RETRANSMISSION  NA 

NUMBER  OF  NODES  IN  SYSTEM 11 

NUMBER  OF  NODES  IN  LOOP 3 

PRESS  *T*  KEY  FOR  NEXT  INSTRUCTION 

NODE  WORKPAGE  PARAMETERS 

CRT  MODE  HAS  DESIGNATOR  4 RDA  4 IN  LOOP 

ALTERNATE  GATEWAY  FUNCTIONAL  ADDRESSES  . . . . 1»  3 

MAXIMUM  INPUT  QUEUE  SIZE  (TO  EXTERNAL)  8 

MAXIMUM  OUTPUT  QUEUE  SIZE  (TO  BITSTREAM)  . . .1 
MAXIMUM  PACKET  XMISSIONS  BEFORE  ERROR  MESSAGE  . . 8 

TIMEOUT  FOR  WRITE  TOKEN  REGERERATION  12 

TIMEOUT  FOR  PACKET  RETRANSMISSION  _.  41 

NUMBER  OF  NODES  IN  SYSTEM  .....  . , 11 

NUMBER  OF  NODES  IN  LOOP 4 

PRESS  * T * KEY  FOR  NEXT  INSTRUCTION 

NODE  WORKPAGE  PARAMETERS 

HOST  NODE  HAS  DESIGNATOR  5 RDA  2 IN  LOOP 

ALTERNATE  GATEWAY  FUNCTIONAL  ADDRESSES  ....  1.  3 

MAXIMUM  INPUT  QUEUE  SIZE  (TO  EXTERNAL)  4 

MAXIMUM  OUTPUT  QUEUE  SIZE  (TO  BITSTREAM)  ....  1 
MAXIMUM  PACKET  XMISSIONS  BEFORE  ERROR  MESSAGE  . . 6 

TIMEOUT  FOR  WRITE  TOKEN  REGENERATION  4 

TIMEOUT  FOR  PACKET  RETRANSMISSION  41 

NUMBER  OF  NODES  IN  SYSTEM 11 

NUMBER  OF  NODES  IN  LOOP 4 

PRE8S  “ T ' KEY  FOR  NEXT  INSTRUCTION 

NODE  WORKPAGE  PARAMETERS 

0ATE#1  NODE  HAS  DESIGNATOR  6 RDA  1 IN  LOOP 

ALTERNATE  GATEWAY  FUNCTIONAL  ADDRESSES  . . . , li  3 

MAXIMUM  INPUT  OUEUE  SIZE  (TO  EXTERNAL)  10 

MAXIMUM  OUTPUT  OUEUE  SIZE  (TO  BITSTREAM)  ....  1 
MAXIMUM  PACKET  XMISSIONS  BEFORE  ERROR  MESSAGE  . . NA 

TIMEOUT  FOR  WRITE  TOKEN  REGENERATION  7 

TIMEOUT  FOR  PACKET  RETRANSMISSION  NA 


1 


2 


2 


L 
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NUMBER  OF  NODES  IN  SYSTEM 11 

NUMBER  OF  NODES  IN  LOOP 4 

PRESS  * T * KEY  FOR  NEXT  INSTRUCTION 

NODE  WORKPAGE  PARAMETERS 

GATE43  NODE  HAS  DESIGNATOR  7 RDA  3 IN  LOOP 

ALTERNATE  GATEUAY  FUNCTIONAL  ADDRESSES  ....  1.  3 

MAXIMUM  INPUT  QUEUE  SIZE  (TO  EXTERNAL)  10 

MAXIMUM  OUTPUT  QUEUE  SIZE  (TO  BITSTREAM)  ....  1 
MAXIMUM  FACKET  XMISSIONS  BEFORE  ERROR  MESSAGE  . . NA 

TIMEOUT  FOR  WRITE  TOKEN  REGENERATION  6 

TIMEOUT  FOR  PACKET  RETRANSMISSION  NA 

NUMBER  OF  NODES  IN  SYSTEM 11 

NUMBER  OF  NODES  IN  LOOP 4 

PRESS  'T1  KEY  FOR  NEXT  INSTRUCTION 

NODE  WORKPAGE  PARAMETERS 

CRT  NODE  HAS  DESIGNATOR  8 RDA  4 IN  LOOP 

ALTERNATE  GATEWAY  FUNCTIONAL  ADDRESSES  ....  If  2 

MAXIMUM  INPUT  QUEUE  SIZE  (TO  EXTERNAL)  8 

MAXIMUM  OUTPUT  QUEUE  SIZE  (TO  BITSTREAM)  ....  1 
MAXIMUM  PACKET  XMISSIONS  BEFORE  ERROR  MESSAGE  . . 8 

TIMEOUT  FOR  WRITE  TOKEN  REGERERATION  12 

TIMEOUT  FOR  PACKET  RETRANSMISSION  41 

NUMBER  OF  NODES  IN  SYSTEM 11 

NUMBER  OF  NODES  IN  LOOP 4 

PRESS  'T*  KEY  FOR  NEXT  INSTRUCTION 

NODE  WORKPAGE  PARAMETERS 

HOST  NODE  HAS  DESIGNATOR  9 RDA  3 IN  LOOP 

ALTERNATE  GATEUAY  FUNCTIONAL  ADDRESSES  ....  If  2 

MAXIMUM  INPUT  QUEUE  SIZE  (TO  EXTERNAL)  8 

MAXIMUM  OUTPUT  QUEUE  SIZE  (TO  BITSTREAM)  ....  1 
MAXIMUM  PACKET  XMISSIONS  BEFORE  ERROR  MESSAGE  . . 8 

“IMEOUT  FOR  WRITE  TOKEN  REGERERATION  14 

TIMEOUT  FOR  PACKET  RETRANSMISSION  41 

NUMBER  OF  NODES  IN  SYSTEM 11 

NUMBER  OF  NODES  IN  LOOP 4 

PRESS  *T*  KEY  FOR  NEXT  INSTRUCTION 

NODE  WORKPAGE  PARAMETERS 

0ATE41  NODE  HAS  DESIGNATOR  10  RDA  1 IN  LOOP 

ALTERNATE  GATEWAY  FUNCTIONAL  ADDRESSES  ....  If  2 

MAXIMUM  INPUT  QUEUE  SIZE  ( YO  EXTERNAL)  10 

MAXIMUM  OUTPUT  QUEUE  SIZE  (TO  BITSTREAM)  ....  1 
MAXIMUM  PACKET  XMISSIONS  BEFORE  ERROR  MESSAGE  . . NA 

TIMEOUT  FOR  WRITE  TOKEN  REGENERATION  4 

TIMEOUT  FOR  PACKET  RETRANSMISSION  NA 

NUMBER  OF  NODES  IN  SYSTEM . 11 

NUMBER  OF  NODES  IN  LOOP 4 

PRESS  *T*  KEY  FOR  NEXT  INSTRUCTION 

NODE  WORKPAGE  PARAMETERS 

BATE#2  NODE  HAS  DESIGNATOR  11  RDA  2 IN  LOOP 

ALTERNATE  GATEUAY  FUNCTIONAL  ADDRESSES  ....  1.  2 

MAXIMUM  INPUT  QUEUE  SIZE  (TO  EXTERNAL)  10 

MAXIMUM  OUTPUT  QUEUE  SIZE  (TO  BITSTREAM)  ....  1 
MAXIMUM  PACKET  XMISSIONS  BEFORE  ERROR  MESSAGE  . . NA 

TIMEOUT  FOR  WRITE  TOKEN  REGENERATION  7 

TIMEOUT  FOR  PACKET  RETRANSMISSION  NA 

NUMBER  OF  NODES  IN  SYSTEM  . 11 

NUMBER  OF  NODES  IN  LOOP  4 

PRESS  'T*  KEY  FOR  NEXT  INSTRUCTION 
BED  V 

EDI  — DEVICE  FULL 
CEXIT3 
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1.4  ESM  Loader  Utility 

The  ESM  Loader  Utility  (ESMLDR)  is  used  for  loading  the  RAM  control 
memories  of  the  ESM  B7*  CIE  microprocessors.  Loading  procedures 
are  described  in  Section  4.3  of  the  ESM  User  Manual.  Microcode 
object  files  normally  reside  in  UIC  [1,20].  The  user  must  be  in 
the  UIC  of  the  object  file  to  be  loaded  when  running  ESMLDR.  The 
object  file  must  consist  of  256  byte  records.  Sixteen  bit  instruc- 
tion words  resulting  from  the  MDMPL  Assembler  are  loaded  into 
sequential  control  memory  locations  consisting  of  12  bit  instruc- 
tions where  the  (left)  most  significant  four  bits  of  the  sixteen 
bit  word  are  dropped.  The  full  4K  of  control  memory  is  loaded  so 
that  when  an  end-of-file  error  condition  arises  the  remainder  of 
memory  is  filled  with  STEP  (octal  607)  instructions.  The  end- 
of-file  error  message  printed  on  the  terminal  is  the  normal  dis- 
play. The  third  and  fourth  instruction  word  is  used  for  a recovery 
mode  GOTO  instruction  for  the  case  of  hardware  failures.  This  GOTO 
instruction  is  loaded  at  the  last  two  instruction  words  so  that 
hardware  failures  which  cause  jumps  to  non-programmed  control 
memory  result  in  STEP'S  being  executed  until  the  error  recovery 
GOTO  instruction  at  the  last  two  words  of  control  memory. 

ESMLDR  runs  on  host  processor  B only  since  loading  hardware  exists 
for  that  machine.  ESM  Tape  #2  contains  the  source  file  (ESMLDR. FOR) , 
object  file  (ESMLDR. OBJ) , and  task  (ESMLDR. TSK) . Task  Builder 
(TKB)  options  include: 

UNITS=2 
ACTFIL=2 
COMMON =M17 10 :RW 
MAXBUF=256 
ASG=TT1 : 1 , SYO:2 
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ESMLDR 


(start) 


' Write  'PLEASE  ENTER 
OBJECT  FILE  NAME’  J 
to  TT1: 


Read  ZA 
from  TT1: 


DEVST(2)  = CODE(J) 


Write  NREC,  '128 
INSTRUCTION  GROUPS 
LOADED.  ' i 


NREC  = 1,32 


NR=NREC 


Read  RECORN  NREC 
of  FILE  ZA  into 
CODE 


99 


Figure  1-20.  ESMLDR 
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ESMLDR  (cont.) 


CODE(J)="607 


DEVST(2)=CODE(.l) 


Figure  1-20.  (Cont.) 


WAIT 
KK  = 1, 

_X)OP 

DEVST(2) 

=CODE(J) 

CODE  (126 

) = IERI 

CODE(12' 

)=IER2 

WAIT 
KK  = 1, 

LOOP 

5 
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1 


FORTRAN  IV 

V01B-02  SAT  26-FEB-77  14152: 

C0RE= 

08K , UIC=C20 » 203  ESMLDR.0BJ= 

0001 

INTEGER  DEVST (6) .CODE! 128) 

0002 

REAL*8  ZA(3> 

0003 

COMMON  /M1710/PEVST 

0004 

DATA  ISTEP/'607/ 

0005 

DATA  IA0N/' 177777/ 

0006 

CALL  ASSIGN! 1,'TTll') 

0007 

WRITE  ! 1 , 1 1 ) 

0008 

11 

FORMAT! IX, 'PLEASE  ENTER  OBJECT  FILE  NAME 

0009 

READ ! 1 , 12 ) ZA 

0010 

12 

FORMAT !3A8> 

0011 

CALL  ASSIGN ! 2 » ZA ) 

0012 

DEFINE  FILE  2(32,128,11,11  > 

0013 

DO  20  NREC=1 , 32 

0014 

NR=NREC 

0015 

READ  < 2 ' NREC, END=99 , ERR=99  > CODE 

0016 

IF  <NR  .EQ.  1)  IER1 =CODE ! 3 ) 

0018 

IF  ! NR  .EO.  1)  IER2=C0DE ! 4 ) 

0020 

DO  18  J=1 ,128 

0021 

DO  16  KK=1 ,5 

0022 

16 

CONTINUE 

0023 

IF  ! CODE ! J > .EC).  IAON)  CODE ! J ) =ISTEP 

0025 

DEVST ! 2 ) =CODE ! J ) 

0026 

18 

CONTINUE 

0027 

WRITE  ! 1 , 1 3 ) NREC 

0028 

13 

FORMAT ! IX, 13, ' 128  INSTRUCTION  GROUPS  1 

0029 

20 

CONTINUE 

0030 

99 

DO  30  J=1 , 128 

0031 

30 

CODE! J)=ISTEP 

0032 

DO  40  N=NR ,31 

0033 

DO  40  J=1 ,128 

0034 

DO  50  KK=1 , 5 

0035 

50 

CONTINUE 

0036 

DEVST !2>=C0DE!J> 

0037 

40 

CONTINUE 

0038 

CODE ( 126  > = IER1 

0039 

CODE ! 127 ) = IER2 

0040 

DO  60  J=1 , 127 

0041 

DO  70  KK=1 , 5 

0042 

70 

CONTINUE 

0043 

DEVST  < 2 > =CODE  < J > 

0044 

60 

CONTINUE 

0045 

END 

PAGE  001 
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1.5  Record  Move  Utility 

The  ESM  Record  Move  Utility  is  used  for  moving  records  of  the  ATEC 
simulation  files  (EFLOCF , EFTRKD,  EFCKTD , EFTERD)  between  host 
processors  A and  B to  maintain  the  directory  file  (EFDIR)  necessary 
for  the  distributed  file  system  of  mode  4 of  the  ESM  User  Language. 
The  utility  exists  in  two  forms,  RCMVl  for  processor  A,  and  RCMV5 
for  processor  B.  The  two  programs  differ  only  in  LID  pair  addresses 
( ICODE ( 3 ) of  message  header),  and  logging  DECSCOPE  terminal  defi- 
nition. ESM  Tape  #1  contains  the  source  (.FOR),  object  (.OBJ), 
task  (.TSK),  and  overlay  description  language  files  (.ODL)  for  the 
two  programs. 

The  overlay  structure  for  the  utility  consists  of  the  main  program 
and  two  overlayed  routines  RDLOOP  and  WRLOOP  which  are  listed  in 
Section  1.3. 

The  program  allows  records  to  be  moved  from  the  host  processor 
which  is  the  primary  dialogue  director  for  the  ESM  terminal  running 
the  utility  to  the  other  host  processor.  The  user  is  given  the 
choice  of  file  and  access  key.  If  the  key  exists  on  the  machine, 
the  record  is  displayed  and  moved  to  the  other  machine  by  means  of 
host-host  interprocess  communication  control  messages.  The  utility 
may  be  used  for  building  a consistent  distributed  file  system  so 
that  multiple  copies  of  records  are  eliminated.  To  terminate  the 
utility,  enter  "DS"  on  the  ESM  terminal.  Note  that  both  processors 
must  be  running  the  utility  for  successful  record  transfers. 

Task  Builder  (TKB ) Commands  for  building  the  utility  task  are: 

TKB  RCMV5.TSK  = RCMV5 . ODL/MP , [1,1]  SYSLIB/LB : $SHORT 

Options  include: 

UNITS=8 
ACTFIL=8 
COMMON=M1710 : RW 
MAXBUF=240 

ASG=TI : 1 , SYO:2:3:4:5:6:7:8 
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RCMV5(con1.) 


Figure  1-21.  (Cont.) 
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IFSH  » ICODE(4) 
KEYH  = ICODE(5) 


READ  RECORD  IFSH 
OF  EFDIR  INTO  DI 


DKKKH  + 1 ) = 0 


DI(KKH)  = KEYH 


IX'  = IFSH  ♦ 2 


Figure  1-21.  (Cont.) 


0001  REAL*8  MOUT.OFIL.IFAR.MVD.XMT.SK8 

0002  INTEGER  DEVST(6) 

0003  INTEGER  DI 

0004  COMMON  /LOOP/ICODE < 1 28 ) . MSK . LSK 

0005  COMMON  /M1710/DEVST 

0006  DIMENSION  0FIL(10.3) » DI ( 100) .LINE ( 40) 

0007  DIMENSION  I FAR ( 10 > . ICON ( 1 28 > . MOUT ( 10 » 1 1 > 

0008  EQUIVALENCE ( LINE  » IFAR) 

000?  DATA  MVD.KYMSKrXMT.IH51/'  MOVED  77577 . 'PRES  XMT'.*2401/ 

0010  DATA  LEOFV  177777/ 

0011  DATA  LHOME r ICRLF » IDC1/ 1 24 . " 106412. * 10400/ 

0012  DATA  SK8/'  '/ 

0013  DATA  LFF4.LFF5/,14. *5000/ 

0014  DATA  LF/* 12/ 

0015  DATA  ILO/*  51 504/ 

0016  DATA  IH15/ "405/ 

0017  DATA  LSK. MSK/M77.  *77400/ 

0018  DATA  IC9H.IHC9/*4405. *2411/ 

0019  DATA  IC4H . IHC4 . IC8H . IHC8/ * 2005 . " 2404 . * 4005 » * 2410/ 

0020  15  FORMAT (IX. 10A8 ) 

0021  IST=1 

0022  DO  130  J=1 . 12? 

0023  DO  140  1=1.70 

0024  140  CONTINUE 

0025  130  K=DEVST ( 1 ) 

0026  I1ST=0 

0027  ICFLG=0 

0028  ICON( 11=258 

002?  DO  22  J=l.ll 

0030  DO  22  1=1.10 

0031  22  MOUT ( I . J 1 =SKB 

0032  CALL  ASSIGNd. 'TTll  ' > 

0033  CALL  ASSIGN(2. 'EFDIR' 1 

0034  DEFINE  FILE  2 ( 1 0 . 100 . U. 1 1 ) 

0035  CALL  ASSIGN ( 3 » ' EFLOCF ' 1 

0036  DEFINE  FILE  3 ( 100 . 1 20 . U . 12 1 

0037  CALL  ASSIGN ( 4 . 'EFCKTD ' 1 

0038  DEFINE  FILE  4 ( 100. 120. U . 13) 

003?  CALL  ASSIGN(5. 'EFTRKD' 1 

0040  DEFINE  FILE  5 ( 1 00 . 1 20 . U. 1 4 ) 

0041  CALL  ASSIGN(6» 'EFTERD' 1 

0042  DEFINE  FILE  6( 100. 120. U. 15) 

0043  CALL  ASSIGN  ( 7.  ' INFO . DAT  ' ) 

0044  DEFINE  FILE  7 ( 396 . 40 . U. 16 > 

0045  CALL  ASSIGN( 8 . 'MSG . DAT ' ) 

0046  DEFINE  FILE  8 ( 21 1 . 40 . U . 1 16 > 

0047  DEVST (5>*0 

0048  25  CALL  RDLOOP 

0049  WRITE ( 1 . 16 ) ( I CODE (J).J=1.4) 

0050  16  FORMAT ( 1 X ,' HEADER= '. 4C8 > 


0051 

IF 

( ICODE (3) 

.EQ. 

IC4H) 

I CODE ( 3 ) = IHC4 

0053 

IF 

( I CODE ( 3 ) 

.EO. 

ICON ) 

I CODE ( 3 ) =IHC8 

0055 

IF 

( ICODE ( 3 ) 

.EQ. 

IC9H ) 

I CODE ( 3 ) = IHC9 

0057 

IF 

(ICODE (3) 

.EQ. 

IH1 5 ) 

GOTO  700 

0059 

IF 

( ICODE ( 4 > 

• NE. 

ILO) 

GOTO  630 

0061 

NRCNO-21 
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FORTRAN  IU 

V01B-02  FRI 

CORE= 

:08K  t UIOC20.20T 

0062 

N0REC=1 

0063 

1ST  = 9999 

0064 

GOTO  12 

0065 

630 

IF  (1ST  .EQ,  1)  GOTO  51 

0067 

IF  (1ST  .EG.  2)  GOTO  52 

0069 

IF  (1ST  .EG.  3)  GOTO  53 

0071 

IF  (1ST  .EG.  4)  GOTO  54 

0073 

51 

NRCNO-1 

0074 

N0REO2 

0075 

IST=2 

0076 

GOTO  12 

0077 

52 

NRCN0=127 

0078 

N0REC=6 

0079 

IST-3 

0080 

GOTO  12 

0081 

53 

IFS=IAND ( LSK  r ICODE ( 4 ) ) 

0082 

IFS=IFS-48 

0083 

IF  (IFS  .GE.  5)  I FS=4 

0085 

IF  (IFS  .GE.  1)  GOTO  90 

0087 

99 

NRCN0=1 1 

0088 

N0REC=1 

0089 

GOTO  12 

0090 

90 

NRCN0=157 

0091 

NOREOl 

0092 

IST  = 4 

0093 

GOTO  12 

0094 

54 

KEY=IAKD(KYHSK, IC.0DE(4> ) 

0095 

READ (2'IFS.ERR=99) (DI(I) 

0096 

DO  550  K=1 > 1 00 

0097 

KK=K 

0098 

IF  (DI(K)  .EG.  0>  GOTO  5 

0100 

IF  (KEY  .EG.  D I ( K > ) GOTO 

0102 

550 

CONTINUE 

0103 

565 

NRCN0=210 

0104 

N0REC=1 

0105 

IST=2 

0106 

GOTO  12 

0107 

560 

LU- IFS+2 

0108 

READ ( L U ' KK »ERR=99) ( (OFIL 

0109 

DO  582  J-l » 3 

0110 

DO  582  I=l»10 

0111 

582 

MOUT ( I » J ) =OFI L ( I » J ) 

0112 

MOUT (1.5) =XMT 

0113 

DO  5100  J=1 . 5 

0114 

5100 

WRITE ( 8 ' J+33 ) ( MOUT ( I > J ) » 

0115 

NRCN0=34 

0116 

N0REC=5 

0117 

IST  = 2 

0118 

DI ( KK ) =-DI ( KK > 

0119 

WRITE  < 2 ' IFS  r ERR=99 ) ( DI ( I 

0120 

ICFLG=1 

0121 

I CON ( 1 ) = I CON ( 1 ) + 1 SHE  T ( 1 . 

0122 

ICON ( 2 ) =0 

0123 

ICON  < 3 ) = IH51 

0124 

ICON( 4 )=IFS 

0125 

ICON ( 5 ) =-DI ( KK ) 

-77  11524:14  PAGE  002 

RCMV5 . OB J=RChV5 . FOR/NOSN/L  I ! 1 
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FORTRAN  IV  V01B-02 

CORE-O0K.  UIC=C20>  203 


FRI  18-MAR-77  11:24514  PAGE  003 

RCMV5 . OB J=RCMV5 . F0R/N0SN/L 1 5 1 


0126 

DO  600  1=1.10 

0127 

600 

I FAR  < I ) =0F IL ( I f 1 ) 

0128 

DO  610  J=1 . 40 

0129 

610 

ICON ( J+5 ) =L INE  ( J ) 

0130 

ICON ( 46 ) =LE0P 

0131 

GOTO  12 

0132 

700 

IFSH=ICODE ( 4 ) 

0133 

KEYH=IC0DE<5> 

0134 

READ  ( 2 ' IFSH  » ERR=99  )(DI(I)»I=1.100> 

0135 

DO  1055  K*1 . 99 

0136 

KKH=K 

0137 

IF  (KEYH  .EQ.  -DI <K) ) GOTO  1060 

0139 

IF  (KEYH  .EQ.  DI(K>)  GOTO  1060 

0141 

IF  ( D I < K > .EQ.  0)  GOTO  1070 

0143 

1055 

CONTINUE 

0144 

1070 

DKKKH+1  > =0 

0145 

1060 

DI  <KKH)=KEYH 

0146 

LU=IFSH+2 

0147 

READ ( LU ' 1 . ERR=99 ) ( ( OFIL ( I. J). 1=1.10 

0148 

DO  300  J=1.40 

0149 

300 

line: j>=icode(j+5) 

0150 

DO  305  1=1 r 10 

0151 

305 

OFIL  ( I » 1 ) =IFAR ( I ) 

0152 

DO  1050  1=1.10 

0153 

DO  1050  J=2.3 

0154 

1050 

OFIL  < I » J ) = MVD 

0155 

WRITE  <2'IFSH. ERR =99 ) (DI ( I > , 1=1 , 100) 

0156 

WRITE (LU'KKH.ERR=99> ( (OFIL(I.J) . 1=1 i 

0157 

GOTO  25 

0158 

12 

CONTINUE 

C 

WRITE  TO  LOOP 

0159 

IF  (NRCNO  .GE.  107)  NRCNO=NRCNO+ 1 

0161 

DO  200  J=4.128 

0162 

200 

I CODE ( J ) =0 

0163 

ICODE (127) =LEOP 

0164 

IF  (NRCNO  .NE.  11)  GOTO  210 

0166 

ICODE ( 4 ) =LHOME 

0167 

DO  220  J=5 .16 

0168 

220 

ICODE ( J ) =LF 

0169 

READ (8' 11 XICODE(I), 1=17.56) 

0170 

ICODE ( 57 ) =LHOME 

0171 

ICODE ( 58 ) =LEOP 

0172 

CALL  WRLOOP ( 1 1 ST  > 

0173 

GOTO  330 

0174 

210 

NWRTS=4 

0175 

IF  (NOREC  .LE.  3)  NWRTS=1 

0177 

IF  (NOREC  .GE.  4 .AND.  NOREC  .LE.  61 

0179 

IF  (NOREC  .GE.  7 .AND.  NOREC  .LE.  9\ 

0181 

NN=NRCNO 

0182 

DO  310  J= 1 . NURTS 

0183 

JJJ=J 

0184 

DO  450  K=4  ? 1 26 

0185 

450 

ICODE (K  > =0 

0186 

IF  (J  .EQ.  1)  I CODE ( 4 ) =LFF4 

0188 

IF  (J  .EQ.  1)  If ODE ( 5 > =LFF5 

0190 

READ ( 8 ' NN  > ERR=500 ) ( I CODE ( I ) .1=6.45) 

NWRTS=2 

NURTS=3 
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0191 

N1=(J-1 >*3+1 

0192 

IF  (NOREC  .LE.  N1 > GOTO  250 

0194 

NN=NN+1 

0195 

READ(8'NN,ERR=500> (ICODE(I) .1=46,85) 

0196 

N2=N1 + 1 

0197 

IF  (NOREC  .LE.  N2)  GOTO  250 

0199 

NN=NN+ 1 

0200 

RE AD  < 8 ' NN , ERR=500 > < ICODE ( I ) . 1=86 . 1 25  > 

0201 

NN=NN+1 

0202 

250 

ICODE < 45 >=ICRLF 

0203 

I CODE ( 85 ) =ICRLF 

0204 

ICODE (125)=ICRLF 

0205 

ICODE ( 1 26 ) =IDC 1 

0206 

IF  <J  .EQ.NWRTS)  ICODE ( 126 >=LHOME 

0208 

CALL  WRLOOP ( 1 1 ST ) 

0209 

I 1 ST=1 

0210 

310 

CONTINUE 

0211 

IF  ( ICFLG  .EQ.  0)  GOTO  330 

0213 

DO  510  J=1.138 

0214 

510 

ICODE ( J ) = ICON ( J ) 

0215 

CALL  WRLOOP < 1 1 ST ) 

0216 

ICFLG=0 

0217 

330 

CONTINUE 

C 

WRITE  OUT  SCREEN 

0218 

DO  70  J=l. NOREC 

0219 

NOR=NRCNO+ J- 1 

0220 

READ ( 8 ' NOR  > ( MOUT (I. J). 1 = 1. 10) 

0221 

70 

WRITE  ( 1 . 1 5 ) ( MOL’T  (I.J).T  = 1.1')) 

0222 

DO  80  J=l.ll 

0223 

DO  80  1=1,10 

0224 

80 

MOUT ( I , J ) =0 

0225 

500 

CONTINUE 

0226 

IF  (1ST  .NE.  9999)  GOTO  25 

0228 

END 

> 
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C0RE=0BK»  UIC=C20.203  RCMV1 ,0BJ=RCMV1 .F0R/N0SN/LI 1 1 

0001  REAL *8  MOUTrOFIL. IFAR,MVD»XMT,SKB 

0002  INTEGER  DEVST<6) 

0003  INTEGER  HI 

0004  COMMON  /LOOP/ ICODF ( 1 28 ) r M5K , LSK 

0005  COMMON  /Ml 710/DEVST 

0004  DIMENSION  OFIL (1 0 r 3 ) , DI <1 00 ) , L INEI40 ) 

0007  DIMENSION  IFAR < 1 0 ) » I CON ( 1 28 ) • MOUT ( 10 . 1 1 ) 

OOOB  EQUIVALENCE ( L INE , IFAR ) 

0009  DATA  MVD,NYMSI\,XMT,IH51/'  MOVED  77577 ,' PRES  XMT','2401/ 

0010  DATA  LEOP/’ 177777/ 

0011  DATA  LHOME » ICRLF , IDC1/ * 24 , ' 104412 r * 10400/ 

0012  DATA  SN8/ ' '/ 

0013  DATA  LFF4.LFF5/* 14, *5000/ 

0014  DATA  LF/* 12/ 

0015  DATA  ILO/ " 5 1 504/ 

0014  DATA  IH1 5/ * 405/ 

0017  DATA  LSNfMSK/* 177, "77400/ 

0018  DATA  IC9H , IHC9/"4401 , "411/ 

0019  DATA  IC4H , IHC4 , 1 C8H , IHC8/ * 2001 , * 404 , * 4001 , 1 410/ 

0020  15  F0RMAT(1X,10A8> 

0021  IST=1 

©022  DO  130  J=1 , 129 

0023  DO  140  1=1,70 

0024  140  CONTINUE 

0025  130  N=DEVST  < 1 ) 

0024  I 1ST=0 

0027  ICFLG=0 

0028  ICON  < 1 ) =258 

0029  DO  22  J=1,U 

0030  DO  22  1=1,10 

0031  22  MOUTH, J)=SN8 

0032  CALL  ASSIGN (1,'TTO!') 

0033  CALL  ASSIGN! 2, 'EFDIR' ) 

0034  DEFINE  FILE  2 < 10 » 100 ,U , 1 1 > 

0035  CALL  ASSIGN < 3 , ' EFLOCF ' > 

0034  DEFINE  FILE  3 ( 100 , 120 , U , 12 ) 

0037  CALL  ASSIGN! 4 , 'EFCK'TD ' > 

0038  DEFINE  FILE  4 < 100 , 1 20 , U , 13 ) 

0039  CALL  ASSIGNC5,  ' EFTRK'D ' ) 

0040  DEFINE  FILE  5 ( 1 00 , 1 20 , U , 1 4 ) 

0041  CALL  ASSIGN<6, 'EFTERD' ) 

0042  DEFINE  FILE  4 ( 1 00 , 1 20 , U , 1 5 ) 

0043  CALL  ASSIGN ( 7 , ' INFO . DAT ' ) 

0044  DEFINE  FILE  7 <396 , 40 , U, 14 ) 

0045  CALL  ASSIGN(8, 'MSG . DAT ' ) 

0044  DEFINE  FILE  8 < 2 1 1 , 40 , U , 1 1 6 > 

0047  DEVST  < 5 ) =0 

0048  25  CALL  RDLOOP 


0049 

0050 

WRITE (1,14) < ICODE(J) ,J=1 
14  FORMAT < IX, 'HEADER=' ,408) 

,4) 

©051 

IF  ( I CODE ( 3 > 

• EO. 

IC4H ) 

ICODE  < 3 ) = IHC4 

0053 

IF  ( ICODE  < 3 > 

. EO , 

I C8H  > 

I CODE ( 3 ) = IHC8 

0055 

IF  ( I CODE  < 3 > 

.EO, 

I C9H ) 

ICODE ( 3 ) = IHC9 

0057 

IF  < ICODE  < 3 > 

.EO. 

IH51  ) 

GOTO  700 

0059 

0041 

IF  ( I CODE  < 4 ) 
NRCN0=21 

.NE. 

ILO)  GOTO  430 
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CORE=08Kf  UIC=C20,203 

0062  NOREC=l 

0063  I ST  ~9999 

0064  GOTO  12 

0065  630  IF  (1ST  .EQ. 

0067  IF  (1ST  .EQ. 

0069  IF  (1ST  .EQ. 


FRI  18-MAR-77  11  HAS  18  PAGE  002 

RCMV1 • 0BJ=RCMU1 . FOR/NOSN/L I ! 1 


EQ.  1)  GOTO 
EQ.  2)  GOTO 
EQ.  3)  GOTO 


IF  (1ST  .EQ.  4)  GOTO  54 

NRCN0=1 

NOREO-2 

I ST  = 2 

GOTO  12 

NRCN0=127 

N0REC=6 

I ST=3 

GOTO  12 

IFS=IANP(LSKf I CODEC  4 > ) 

IFS=IFS-48 

IF  ( IFS  .GE.  5)  IFS=4 

IF  (IFS  .GE.  1 > GOTO  90 

NRCNO-11 

NOREC= 1 

GOTO  12 

NRCN0=157 

N0REC=1 

IST=4 

GOTO  12 

KEY=IAND(KYMSKfIC0DE(4>  > 

READ  (2  "IFS  fERR-99'  (Did)  .1  = 1.100) 

DO  550  K=1 t 100 
KK=K 

IF  ( P I ( K ) .EQ.  0)  GOTO  565 
IF  (KEY  .EQ.  D I ( K ) > GOTO  560 
CONTINUE 

NRCN0=210 
N0REC=1 
IST=2 
GOTO  12 
L,U=IFS+2 

READ ( LU ' KK » ERR=99 ) ( (OFIL  ( I , J)  f 1 = 1 f 1 0 > , J=1  f 3) 
DO  582  J= 1 f 3 
DO  582  1=1 f 10 

MOUT(IfJ)=OFIL(IfJ) 

MOUT (1,5 ) = XMT 
DO  5100  J=1 , 5 

WR ITE(8'J+33)( MOUT (IfJ)fI=1f10> 

NRCN0=34 
N0REC=5 
I ST  =2 

DI(NK)=-DI(KK> 

URITE ( 2 ' IFS ,ERR=99 ) (DI ( I > ,1=1 fIOO) 

ICFLG=1 

I CON ( 1 ) = ICON ( 1 ) +ISHFT (1,8) 

I CON ( 2 ) =0 
ICON ( 3 > = IH1 5 
I CON ( 4 ) = IFS 
ICON (5)=-DI(NN> 
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CORE=08K.  UIC=C20f203  RCMV1 . OB J=RCMV1 . F0R/N0SN/LI 1 1 

0126  DO  600  1=1.10 

0127  600  I FAR ( I ) =0F IL ( I > 1 ) 

0128  DO  610  J=1 f 40 

0129  610  IC0N(J+5>  =L INE ( J > 

0130  I CON  < 46 ) =LE0F' 

0131  GOTO  12 

0132  700  IFSH=IC0DE<4) 

0133  KEYH= ICODE  < 5 ) 

0134  RE AD  < 2 ' I FSH  f ERR=99 >(DI(I)fI=1f100> 

0135  DO  1055  K=1.99 

0136  KKH=K 

0137  IF  ( KEYH  .EQ.  -DI(K)>  GOTO  1060 

0139  IF  (KEYH  .EG.  DI(K>)  GOTO  1060 

0141  IF  (DI(K)  .EG.  0)  GOTO  1070 

0143  1055  CONTINUE 

0144  1070  DI < KKH+1 ) =0 

0145  1060  DI < KKH ) =KE YH 

0146  LU=IFSH+2 

0147  RE AD (LU' If  ERR=99  > ( ( OFIL ( IfJ)fI=1f10)fJ=1f3) 

0148  DO  300  J=1  f 40 

0149  300  LINE (J)=IC0DE(J+5> 

0150  DO  305  1=1 f 10 

0151  305  OFIL< I f 1 >=IFAR< I > 

0152  DO  1050  1=1 f 10 

0153  DO  1050  J=2 1 3 

0154  1050  OFIL(IfJ)=MVD 

0155  URITE(2/IFSHfERR=99) <DI( I > fI=1 f 100) 

0156  URITE(LU/KKHfLKR=?9) ( (OFILv I f J) fI=1 f 10) f J=1 f3) 

0157  GOTO  25 

0158  12  CONTINUE 

C URITE  TO  LOOP 

0159  IF  ( NRCNO  .GE.  107)  NRCN0=NRCN0+1 

0161  DO  200  J=4  f 1 28 

0162  200  ICODE ( J > =0 

0163  ICODE (127) =LEOP 

0164  IF  (NRCNO  .NE.  11)  GOTO' 210 

0166  ICODE ( 4 ) =LHOME 

0167  DO  220  J=5f16 

0168  220  ICODE ( J ) =LF 

0169  READ (S' 11 > ( ICODE ( I ) f 1 = 17 f 56 ) 

0170  ICODE (57) =LHOME 

0171  ICODE ( 58 ) =LEOP 

0172  CALL  URLOOF'  ( 1 1ST ) 

0173  GOTO  330 

0174  210  NWRTS=4 

0175  IF  (NOREC  .LE.  3)  NURTS=1 

0177  IF  (NOREC  .GE.  4 .AND.  NOREC  .LE.  6)  NURTS=2 

0179  IF  (NOREC  .GE.  7 .AND.  NOREC  .LE.  9)  NWRTS=3 

0181  NN=NRCNO 

0182  DO  310  J=1fNURTS 

0183  JJJ=J 

0184  DO  450  K=4 , 126 

0185  450  ICODE ( K ) =0 

0186  IF  (J  .EG.  1)  ICODE ( 4 ) =LFF 4 

0188  IF  ( J .EG.  1)  I CODE  ( 5 ) =LFF5 

0190  READ ( 8 ' NN  f ERR=500 ) ( ICODE ( I ) f I =6 f 45 ) 
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CORE=08K  . UIC=C20 1 203  RCMV1 . 0BJ=RCMV1 . FOR/NOSN/LI 1 1 

0191  N1=(J-1>*3+1 

0192  IF  (NOREC  .LE.  Nl)  GOTO  250 

0194  NN=NN+1 

0195  READ(8'NN>  ERR=500 ) ( I CODE (I) . 1=46 . 85 ) 

01 96  N2=N1+1 

0197  IF  (NOREC  .LE.  N2)  GOTO  250 

0199  NN=NN+1 

0200  READ < 8 ' NN » ERR=500 ) ( ICODE ( I ) .1=86.125) 

0201  NN=NN+ 1 

0202  250  ICODE  < 45 ) = ICRLF 

0203  ICODE ( 85 ) = ICRLF 

0204  ICODE  < 1 25 ) = I CRLF 

0205  ICODE ( 1 26 ) =IDC 1 

0206  IF  <J  .EC1.NWRTS)  ICODE ( 126 ) =LHOME 

0208  CALL  URL OOP ( 1 1ST ) 

0209  I 1ST= 1 

0210  310  CONTINUE 

0211  IF  ( ICFLG  .EO.  0)  GOTO  330 

0213  DO  510  J=1 . 128 

0214  510  ICODEC J)=ICON( J) 

0215  CALL  URLOOP(IIST) 

0216  I CFLG=0 

0217  330  CONTINUE 

C WRITE  OUT  SCREEN 

0218  DO  70  J=l. NOREC 

0219  N0R=NRCN0+J-1 

0220  READ (8 'NOR ><MOUT< I, J) .1=1.10) 

0221  70  WRITE ( 1 r 15) ( MQUT (I, J). 1=1.10) 

0222  DO  80  J=l,ll 

0223  DO  80  1=1.10 

0224  80  MOUT < I, J>=0 

0225  500  CONTINUE 

0226  IF  (1ST  .NE.  9999)  GOTO  25 

0228  END 

> 


; 
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1.6  Interprocess  Communication  and  Resource  Sharing  Demonstration 
Program 

This  program  is  used  to  illustrate  how  the  ESM  may  be  used  to  per- 
form interprocess  communication  and  resource  sharing  experiments. 

After  LOGON,  the  Logical  ID/Functional  Address  (LID/FAD)  Table 
of  LID's  1-100  is  displayed  for  the  dialogue  director  host  on  an 
ESM  terminal.  The  same  table  for  the  other  host  is  then  displayed 
after  the  operator  transmits  a character (s) . After  the  next  CRT 
transmission  two  new  logical  ID's  are  created  in  the  system. 

Logical  ID's  81  and  82  are  created  such  that  81  is  owned  by  pro- 
cessor B loop  2 (FAD  2)  and  82  is  owned  by  processor  A loop  1 
(FAD  1) . Special  control  packets  are  sent  to  the  two  host  nodes 
and  two  gateway  nodes  connecting  loops  1 and  2,  and  the  system 
control  disk  file  (INFO.DAT)  is  updated  to  reflect  the  change. 

After  all  tables  are  updated  and  a system  lock  is  terminated  the 
updated  LID/FAD  table  for  the  dialogue  director  host  is  displayed. 

After  the  next  CRT  transmission  the  updated  table  for  the  other 
host  is  displayed.  After  the  next  CRT  transmission,  the  dialogue 
director  host  sends  a bid  request  to  the  other  host  using  the  new 
LID's.  The  other  host  responds  to  the  bid  and  the  dialogue  direc- 
tor host  displays  the  message  BID  followed  by  a request  for  a 
message.  When  the  other  host  node  is  placed  in  a do  not  execute 
state  the  dialogue  director  performs  a 20  second  timeout  and 
responds  with  NC  BID.  If  the  bid  has  been  acknowledged  a message 
entered  on  the  ESM  terminal  and  transmitted  is  displayed  on  the 
other  host's  DECSCOPE  implemented  by  host-host  messages  using  the 
new  LID's.  The  tables  are  then  returned  to  their  original  state  and 
displayed  thus  destroying  the  LID's  that  were  created  for  the 
interprocess  communication.  Entering  "DS"  at  an  ESM  terminal 
terminates  the  program. 

The  program  exists  in  two  forms,  PROCl  for  host  processor  A,  and 
PROC5  for  host  processor  B.  ESM  Tape  #1  contains  the  source 
(.FOR),  object  (.OBJ),  task  (.TSK),  and  overlay  description  lan- 
guage files  ( . ODL)  for  the  program.  The  overlay  structure  consists 
of  the  main  program  and  two  overlayed  routines  RDLOOP  and  WRLOOP 
which  are  listed  in  Section  1.3. 

The  Task  Builder  (TKB)  commands  for  the  program  are:  j;| 

TKB  PROC  5 . TSK=PR0C  5 . ODL/MP , [1,1]  SYSLIB/LB : $SH0RT . 

Options  include: 

UNITS=3 
ACTFIL=3 
MAXBUF=80 
COMMON=M1710 : RW 
ASG=TI : 1 , SYO: 2 : 3 


.1 
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Both  host  processors  must  be  running  the  demonstration  program  for 
interprocess  communication.  Before  running  the  program  the  STESM 
indirect  command  file  must  be  activated  (by  entering  (§  STESM  at  the 
DECSCOPE)  and  the  ESM  loops  cleared  to  initialize  the  system  control 
file  (INFO.DAT)  and  nodal  LID/FAD  tables. 
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Pr(0C5 


START 


WAIT 

- 


ICODE(3) 
= IHC9 


J CODE!  3) 


ICODF.r  , 


lCODE(4 ) 
i "51504" 


4BTS1  mi 

181T82  82 


NRCNO  * 21 
NOREC  * 1 


ND  « 5 
NDO  * 1 


1ST  = 9999 


RDI.OOP 


WRITE  ICODE(J),  .1 


ICODE(3) 
= IHC4 


ICODE(3) 


ICODE(3) 


ICODE(3) 
= IHC8 


Figure  1-22.  PR0C5 
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PR0C5  (cont. ) 


Figure  1-22.  (Cont.) 
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PR0C5  (cont.) 


RLNE(l) 
= ”aaa2” 


I = MOD  <DEVST(3).  2) 


RLNE(2) 

= " AAA  1 " 


WRITE  RECORD  NR 
INTO  INFO.  DAT  FR  RLNE 


7 t 

/ 

WAIT 

LOOP 

1=1,10 

NR  = 52 


DELTA  = 
SECNDS(Tl) 


NR  = (NDO  -1) 
*6+121+6 


ICODE(l)  = ICODE(l)  + 1 
ICODE(2)  = 0 

1CODEI3)  = 82  + ISH FT(81 , 8) 
ICODE(4)  = LEOP 


K = DEVST(l) 


WRLOOP 

(I1ST) 


DEVST(5>  = 0 


I T1  = SECNDS(0.  ) 


ICODE(4)  = " B" 
ICODE(5)  * "ID" 
ICODE<6>  * I. FOP 


Figure  1-22.  (Cont.) 


PR0C5  (cont.) 


(SAME  AS 
P0000  EXCEPT 
NO  CONTROL 
PACKET  WRITE) 


ILM  = IANDLMSK,  ICODE(J)) 
ILL  = IAND(LSK,  ICODE(J)) 


KKK  = KKK-1 


ICODE(KKK)  = 

IAND(LSK.  ICODE(KKK)) 
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CORE=O0Kr  UIC=C20.  203  PR0C5 . OB J=PR0C5 . FOR/NOSN/LI : 1 


C INTERPROCESS  COMM  & RESOURCE  SHARING  DEMO 

C 

0001  INTEGER  DEVST(6> 

0002  COMMON  /LOOP/ICODE( 128) fMSKfLSK 

0003  COMMON  /Ml  71 0/PEVST 

0004  REAL*4  R0NEfRTU0fRLNE(20>fRSPC 

0005  REAL*8  MOUT (10.11) 

0006  DATA  IH1H. IHH1 / * 405 . ‘ 2401/ 

0007  DATA  IC9H  > INC9/ * 4405.  *2411/ 

0008  DATA  IC4H . IHC4  . IC8H  r IHC8/ *2005 f * 2404 • * 4005  . * 2410/ 

0009  DATA  ILO. ICVA.LEOP/" 51504 f * 125125. * 177777/ 

0010  DATA  RONEfRTUO.RSPC/'  1'.'  2'f'  '/ 

0011  DATA  NOfIBfID/'NO'f'  B'f'ID'/ 

0012  DATA  LSK/*377/ 

0013  DATA  LHOME . ICRLF fIDC1/"24f  * 106412 f * 10400/ 

0014  DATA  UFF4fLFF5/,14f *5000/ 

0015  DATA  LF/ * 1 2/ 

0016  DATA  MSK/* 177400/ 

0017  15  FORMAT < IX f10A8> 

0018  DO  130  J=1 f 129 

0019  DO  140  1 = 1 f 70 

0020  140  CONTINUE 

0021  130  K=DEVST(1) 

0022  I1ST=0 

0023  CALL  ASSIGNd.  'TT15  ') 

0024  CALL  ASSIGN(2f'INF0.DAT'> 

0025  DEFINE  FILE  2 < 396 f 40 f U f 1 1 ) 

0026  CALL  ASSIGN(3f 'MSG. DAT' ) 

0027  DEFINE  FILE  3<211 f 40fUf 12) 

0028  DEVST  <5)=0 

0029  IST=1 

0030  I82T81 =81+ISHFT (82.8) 

0031  I81T82=82+ISHFT(81 ,8) 

0032  ND=5 

0033  ND0=1 

0034  25  CALL  RDLOOP 

0035  WRITE ( 1 . 16 ) ( I CODE  < J ) f J=1 .4) 

0036  16  FORMATUX.  'HEADER='  ,408) 

0037  IF  < ICODE < 3 ) .EQ,  IC4H)  ICODE ( 3 > = IHC4 

0039  IF  < ICODE ( 3 ) ,E0.  IC8H)  ICODE  < 3 ) = IHC8 

0041  IF  ( ICODE (3)  .EG.  IC9H)  ICODE ( 3 ) =IHC9 

0043  IF  < ICODE (3)  .EO.  I82T81)  GOTO  700 

0045  IF  < ICODE < 4 ) . NE . ILO)  GOTO  630 

0047  NRCN0=21 

0048  N0REC=1 


0049 

0050 

0051 

IST=9999 
GOTO  12 
630  IF  (1ST 

.EQ. 

1 ) 

GOTO 

51 

0053 

IF 

(1ST 

.EQ. 

2) 

GOTO 

52 

0055 

IF 

(1ST 

.EQ. 

3) 

GOTO 

53 

0057 

IF 

(1ST 

.EQ. 

4) 

GOTO 

54 

0059 

IF 

( 1ST 

.EQ. 

5) 

GOTO 

55 

0061 

IF 

(1ST 

,EQ . 

6) 

GOTO 

56 

0063 

IF 

(1ST 

.EQ. 

7) 

GOTO 

57 

0065 

IF 

(1ST 

.EQ. 

8) 

GOTO 

58 

0067 

IF 

(1ST 

.EQ. 

9) 

IST= 
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IV 
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CORE=08N.  UIC=C20 » 203  PR0C5 . OB J=FR0C5 . F0R/N0SN/L I 5 1 

006? 

GOTO  51 

0070 

51 

NRCN0= 1 

0071 

N0REC=2 

0072 

IST=2 

0073 

GOTO  12 

0074 

52 

DO  362  J= 1 r 6 

0075 

NR=<ND-1 >#6+121+J 

0076 

READ < 2 ' NR  > < MOUT  < I . J > . 1 = 1 . 1 0 > 

0077 

362 

WRITE<3'44+J>  <M0UT( I , J) ,1  = 1, 10) 

0078 

NRCN0=45 

0079 

N0REC=6 

0080 

IST=IST+1 

0081 

GOTO  12 

0082 

53 

DO  363  J=1  * 6 

0083 

NR= ( NDO- 1 >*6+121+J 

0084 

READ ( 2 ' NR ) ( MOUT <I.J).I=1.10> 

0085 

363 

WRITE<3'44  + J>  <M0UT< I . J) .1  = 1 .10) 

0086 

NRCN0=45 

0087 

N0REC=6 

0088 

IST=IST+1 

0089 

GOTO  12 

0090 

54 

ICODE ( 1 > = ICVA 

0091 

I CODE  < 5 ) =LE0P 

0092 

ICODE  < 2 > = 1 6 

0093 

I CODE ( 4 ) =81 +1 SHFT (2.8) 

0094 

ITSV=ICODE ( 3 > 

0095 

ICODE ( 3 ) =IHH1 

0096 

CALL  URLOOTC IloT) 

0097 

IC0DE(3)=5+I SHFT (5.8) 

0098 

CALL  WRLOOP < 1 1ST) 

0099 

ICODE  < 3 ) =6+1 SHFT (5.8) 

0100 

CALL  WRLOOP ( 1 1 S T ) 

0101 

ICODE  <4)=82+I SHFT < 1 .8) 

0102 

CALL  WRLOOP(IIST) 

0103 

ICODE ( 3 ) =IHH J 

0104 

CALL  WRLOOP ( I 1ST) 

0105 

ICODE  < 3 > =5+ 1 SHF  T ( 5 . 3 ) 

0106 

CALL  WRLOOP (1 1ST) 

0107 

ICODE < 3 ) =2+ 1 SHF  T < 5 » 8 ) 

0108 

CALL  WRLOOP (I 1ST) 

0109 

IC0DE<3)=ITSV 

0110 

ICODE ( 1 )=ICODE< 1 >+l 

0111 

ICODE  < 2 > =0 

0112 

NR=(ND-1 >*6+121+6 

0113 

331 

READ ( 2 ' NR  > < RLNE ( I ) . I = 1 . 20  > 

0114 

DO  332  LL  = 1 » 20 

0115 

332 

IF  (RLNE(LL)  .EO.  0)  RLNE < LL > = RSPC 

0117 

RLNE ( 1 ) =RTWO 

0118 

RLNE(2)=R0NE 

0119 

WRITE ( 2 ' NR )(RLNE(I ) . 1=1 .20) 

0120 

IF  <NR  .EO.  127)  GOTO  52 

0122 

NR=(ND0-1 >*6+121+6 

0123 

GOTO  331 

0124 

55 

GOTO  53 

0125 

56 

ICODE  < 1 ) = ICODE  < 1 ) + 1 

0126 

ICODE (2)=0 
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0127 

I CODE  ( 3 ) =82  + 1 SITFT  ( 81  > 8 ) 

0128 

IC0DE(4)=LE0F' 

0129 

CALL  URLOOP ( 1 1ST  > 

0130 

T 1 =SECNDS ( 0 . ) 

0131 

90 

I=MOD(DEVST (3) » 2) 

0132 

IF  (I  .EQ.  1)  GOTO  120 

0134 

IF  (I  .EQ.  -1)  GOTO  120 

0136 

DO  110  1=1.10 

0137 

110 

CONTINUE 

0138 

DELTA=SECNDS(T1 ) 

0139 

IF  (DELTA  .GE.  20.)  GOTO  150 

0141 

GOTO  90 

0142 

120 

DO  131  J=1 » 129 

0143 

DO  141  1=1.3 

0144 

141 

CONTINUE 

0145 

K=DEUST(1) 

0146 

131 

CONTINUE 

0147 

DEVST  <5>=0 

0148 

ICODE ( 4 ) =1 B 

0149 

I CODE ( 5 ) =ID 

0150 

IC0DE(6)=LE0P 

0151 

GOTO  160 

0152 

150 

ICODE ( 4 ) =N0 

0153 

ICODE ( 5 ) = I B 

0154 

ICODE  < 6 ) = ID 

0155 

ICODE ( 7 ) =LEOP 

0156 

160 

ICODE  < 1 ) =0 

0157 

ICODE ( 2 ) =0 

0158 

ICODE ( 3 ) =ITSV 

0159 

CALL  URLOOP ( 1 1 ST ) 

0160 

IF  < ICODE <4 ) .EE).  IB)  GOTO  170 

0162 

IST  = 1 

0163 

GOTO  25 

0164 

170 

NRCN0=14 

0*65 

NOREC= 1 

0166 

IST=7 

0167 

GOTO  12 

0168 

57 

IC0DE(3)=82+ISHFT (81.8) 

0169 

CALL  URLOOP (1 1ST) 

C‘*  70 

ICODE ( 1 ) = ICUA 

0i71 

ICODE (5)=LE0P 

0172 

ICODE ( 2) =16 

0173 

ICODE ( 4 ) =8 1 

0174 

ICODE ( 3 ) = I HH1 

0175 

CALL  URLOOP ( 1 1ST) 

0176 

I CODE  ( 3 > =5 1 1 SI4FT  (5.8) 

0177 

CALL  URLOOP ( 1 1 ST ) 

0178 

ICODE ( 4 > =82 

0179 

CALL  URLOOP'  ( 1 1 ST ) 

0180 

I CODE ( 3 ) = IHU1 

0181 

CALL  URLOOP (1 1ST) 

0182 

ICODE ( 3 ) =1 TSV 

0183 

IC0DE(1 ) = I CODE ( 1 ) + 1 

0184 

ICODE ( 2) =0 

0185 

NR=(ND-1 )*6f 121+6 

0186 

341 

READ ( 2 ' NR ) ( RLNE ( I >,1=1,20) 
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0187 

DO  342  LL  = 1 f 20 

0188 

342 

IF  (RLNE(LL)  .EG.  0)  RLNE < LL >=RSPC 

0190 

RLNE  ( 1 ) =RSF'C 

0191 

RLNE  ( 2 ) =RSF’C 

0192 

MR  I TE  ( 2 ' NR  ) ( RLNE  < I > . I = 1 . 20  ) 

0193 

IF  <NR  .EO.  127)  GOTO  52 

0195 

NR=(ND0-1 )*6+121+6 

0196 

GOTO  341 

0197 

58 

GOTO  53 

0198 

700 

icode(4>=iand(lskfIoope(4)  > 

0199 

IF  (IC0PE(4)  ,NE.  LSK)  GOTO  800 

0201 

ICODE  < 1 )= ICODE ( 1 ) + 1 

0202 

ICODE  < 2 ) =0 

0203 

ICODE  ( 3 ) -82+ISHFT  ( 81 f 8 ) 

0204 

IC0DE(4)=LE0P 

0205 

CALL  WRLOOP (11  ST  > 

0206 

GOTO  25 

0207 

800 

HO  810  J=4 1 120 

0208 

KKK=J 

0209 

ILM=IAND(MSKf1C0DE(J) ) 

0210 

ILL=I AND ( LSK  t ICODE  < J ) ) 

0211 

IF  (ILM  .EO.  MSK ) GOTO  820 

0213 

810 

IF  (ILL  .EO.  LSK)  GOTO  830 

0215 

820 

ICODE  < KKK > = 1 AND ( LSK  f I CODE ( KKK ) > 

0216 

GOTO  840 

0217 

830 

KKK=KKK- 1 

0218 

840 

WRITE ( 1 f 20  > ( ICODE < J > , J=4  f KKK ) 

0219 

20 

FORMAT ( IX f39A2/1Xf39A2/1Xf3?A2/> 

0220 

GOTO  25 

0221 

12 

CONTINUE 

0222 

IF  ( NRCNO  .GE.  107)  NRCN0==NRCN0+1 

0224 

DO  200  J=4  f 1 28 

0225 

200 

ICODE ( J ) =0 

0226 

ICODE  (127)  =LEOF' 

C227 

IF  (NRCNO  .NE.  11)  GOTO  210 

0229 

ICODE (4 ) =LMOME 

0230 

DO  220  J=5  f 1 6 

0231 

220 

ICODE  < J > =LF 

0232 

READ (8 ' 1 1 ) ( ICODE (I)fI  = 17f 56  ) 

0233 

ICODE ( 57 )=LHOME 

0234 

ICODE ( 58 )=LEOF 

0235 

CALL  WRLOOP (I 1ST) 

0236 

GOTO  330 

0237 

210 

NWRTS=4 

0238 

IF  (NOREC  .LE.  3)  NWRTS=1 

0240 

IF  (NOREC  .GE.  4 .AND.  NOREC  .LE.  6 

0242 

IF  (NOREC  .GE.  7 .AND.  NOREC  .LE.  9. 

0244 

NN=NRCNO 

0245 

DO  310  J=1fNWRTS 

0246 

JJJ=J 

0247 

DO  450  K=4  f 1 26 

0248 

450 

IC0DE(K)=0 

0249 

IF  (J  .EO.  1)  I CODE ( 4 ) =LFF 4 

0251 

IF  (J  .EQ.  1)  ICODE ( 5 ) =LFF5 

0253 

READ(3'NNfERR=500) (ICODE(I) fI=6f45) 

0254 

N1=(J-1)*3F1 

PAGE  0 04 


1-232 


FEDERAL  AND  SPECIAL  SYSTEMS  GROUP 


r:* 


I 

T 

FORTRAN  IV  V01B-02  FRI  18 -MAR-77  13)01)02  PAGE  005 

C0RE=08K i UIC=C?0»  203  PR0C5.0BJ=PR0C5.F0R/N0SN/LI 5 1 


0255 

IF  (NOREC  .LE.  Nl)  GOTO  250 

0257 

NN=NN+1 

0258 

READ  < 3 ' NN » ERR=500 ) (ICO DELI) ,1=46,85) 

0259 

N2=N1+1 

0260 

IF  (NOREC  .LE.  N2>  GOTO  250 

0262 

NN=NN+ 1 

0263 

READ(3'NN»ERR=500> < I CODEC  I ) « 1=86,125) 

026 A 

NN=NN+1 

0265 

250 

ICODE ( 45  > = ICRLF 

0266 

ICODE  < 85 ) = I CRLF  , 

0267 

ICODE < 125 >=ICRLF 

0268 

ICODE  <126  > = IDC1 

0269 

IF  <J  ,E0.  NWRTS > ICODE (126) =LHOME 

0271 

CALL  URLOOP ( I 1ST ) 

0272 

I 1ST=1 

0273 

310 

CONTINUE 

0274 

330 

CONTINUE 

0275 

DO  70  J=lr NOREC 

0276 

NOR=NRCNO+ J- 1 

0277 

READ < 3' NOR) ( MOUT ( I , J > , 1=1 , 10 ) 

0278 

70 

WRITE (1,15) (MOUT(I, J) ,1=1,10) 

0279 

DO  80  J=l.ll 

0280 

DO  80  1=1,10 

0281 

80 

MOUT  < I , J ) =0 

0282 

500 

CONTINUE 

0283 

IF  (1ST  .NE.  9999)  GOTO  25 

0285 

END 

> 
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0001 

INTEGER  DEVST  ( 6 ) 

0002 

COMMON  /L00P/IC0DE(  128)  iMSK'tLSK 

0003 

COMMON  /M1710/DEVST 

0004 

REAL*4  RONE  » RTWO  r RLNE  ( 20 ) t F'SPC 

0005 

REAL*8  MOOT (10>11) 

0006 

DATA  IH1H, IHHl/'405» '2401/ 

0007 

DATA  IC9H » IHC9/ "4401. "411/ 

0008 

DATA  IC4H, IHC4, IC8H , IHC8/ • 2001 , "404, '4001 , 

0009 

DATA  ILO » I CVA » LEOP/ * 51 504 > ■ 125125r  * 177777/ 

0010 

DATA  RONE f RTWO, RSPC/'  1','  2'.'  '/ 

0011 

DATA  NO » IB » I D/ ' NO ' » ' B'.'ID'/ 

0012 

DATA  LSKV377/ 

0013 

DATA  LHOME 1 1 CRLF »IDCl/*24» "1 06412 1 ’ 10400/ 

0014 

DATA  LFF4 » LFF5/ ’ 14 » ■ 5000/ 

0015 

DATA  LF/“ 12/ 

0016 

DATA  MSKV 177400/ 

0017 

15 

FORMAT  < IX » 1 0A8 ) 

0018 

DO  130  J=1 » 129 

0019 

DO  140  I = 1 » 70 

0020 

140 

CONTINUE 

0021 

130 

K=DEVST< 1 ) 

0022 

I 1ST=0 

0023 

CALL  ASSIGN< 1 r 'TT05 ' ) 

0024 

CALL  ASSIGN ( 2 » ' INFO . DAT ' ) 

0025 

DEFINE  FILE  2 ( 396 . 40 r U . I 1 > 

0026 

CALL  ASSIGN ( 3 . ' MSC . DAT ' ) 

0027 

DEFINE  FILE  3 < 21 1 » 40 > U » 12 ) 

0028 

DEVST ( 5 ) =0 

0029 

IST=1 

0030 

1 82T81 =81  + ISHFT  < 82 » 8 ) 

0031 

181 T82=82+ ISHFT ( 81 r 8 ) 

0032 

ND=1 

0033 

ND0=5 

0034 

25 

CALL  RDLOOP 

0035 

WRITE (1>16)(IC0DE(J)f J=1 » 4 > 

0036 

16 

FORMAT ( 1X» ' HEADER= ' » 408 ) 

0037 

IF  ( I CODE ( 3 ) .EO.  IC4H ) ICODE ( 3 ) =IHC4 

0039 

IF  ( ICODE ( 3 > .EQ.  IC8H)  ICODE ( 3 ) = IHC8 

0041 

IF  C ICODE (3  > .EQ.  IC9H)  ICODE ( 3 ) = IHC9 

0043 

IF  ( ICODE ( 3 > .EQ.  I81T82)  GOTO  700 

0045 

IF  ( ICODE ( 4 > .NE.  ILO)  GOTO  630 

0047 

NRCN0“21 

0048 

N0REC=1 

0049 

IST=9999 

0050 

GOTO  12 

0051 

630 

IF  (1ST  .EQ.  1)  GOTO  51 

0053 

IF  (1ST  .EQ.  2)  GOTO  52 

0055 

IF  (1ST  .EQ.  3)  GOTO  53 

0057 

IF  (1ST  .EQ.  4)  GOTO  54 

0059 

IF  (1ST  .EQ.  5)  GOTO  55 

0061 

IF  (1ST  .EQ.  6)  GOTO  56 

0063 

IF  (1ST  .EQ.  7)  GOTO  57 

0065 

IF  (1ST  .EQ.  8)  GOTO  58 

0067 

IF  (1ST  .EQ.  9)  IST=1 
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0069 

GOTO  51 

0070 

51 

NRCN0=1 

0071 

N0REC=2 

0072 

IST=2 

0073 

GOTO  12 

0074 

52 

00  362  J=1 » 6 

0075 

NR=(ND-1 >*6+121+J 

0076 

READ ( 2 ' NR )(M0UT(I»J).I=1»10) 

0077 

362 

WRITE(3'44+J> (MOUTH. J) >I=1> 

0078 

NRCN0=45 

0079 

NOR EC=6 

0080 

IST= I ST+1 

00  a 1 

GOTO  12 

0082 

53 

DO  363  J=1  > 6 

0083 

NR= ( NDO-1 ) *6  + 121 +J 

0084 

READ < 2 ' NR ) (MOUTH  . J>  . 1 = 1 » 10) 

0085 

363 

URI  TE(-3'44  + J)(  MOUT  (I.J).I=1> 

0086 

NRCN0=45 

0087 

N0REC=6 

0088 

IST=IST+1 

0089 

GOTO  12 

0090 

54 

I CODE ( 1 ) = I CVA 

0091 

I CODE  (5)=L.E0P 

0092 

ICODE ( 2 ) = 1 6 

0093 

1C0DE (4>=81+ISHFT(2r8) 

0094 

ITSV=ICODC ( 3 ) 

0095 

ICODE ( 3 ) =IHH1 

0096 

CALL  URLOOP (11  ST  > 

0097 

I CODE ( 3 > =5+ 1 SHFT ( 5 > 8 > 

0098 

CALL  URLOOP (1 1ST) 

0099 

I CODE ( 3 > =6+ 1 SHFT ( 5 » 8 > 

0100 

CALL  URLOOP ( 1 1 ST ) 

0101 

IC0DE(4)=82  + I SHFT ( 1 » 8 > 

0102 

CALL  URLOOP (1 1ST) 

0103 

ICODE ( 3 ) = IHH1 

0104 

CALL  URLOOP(IIST) 

0105 

IC0DE(3)=5+I SHFT ( 5 f 8 ) 

0106 

CALL  URLOOP (I 1ST) 

0107 

IC0DE(3)=2+T  SHFT ( 5 1 8 ) 

0108 

CALL  URLOOP ( 1 1 ST ) 

0109 

ICODE ( 3 > = 1 TSV 

0110 

ICODE ( 1 ) = ICODE ( 1 ) +1 

0111 

ICODE ( 2 ) =0 

0112 

NR=(ND-1 >*6+121+6 

0113 

331 

READ ( 2 ' NR )(RLNE(I)> 1=1.20) 

0114 

DO  332  LL=1 . 20 

0115 

332 

IF  (RLNE(LL)  .Ed.  0)  RLNE(LL 

0117 

RLNE ( 1 ) =RTWO 

0118 

RLNE ( 2 ) =RONE 

0119 

WRITE (2 'NR) (RLNEt 1) r I- 1 .20) 

0120 

IF  (NR  .EQ.  151)  GOTO  52 

0122 

NR= ( NDO-1 )*6+121+6 

0123 

GOTO  331 

0124 

55 

GOTO  53 

0125 

56 

IC0DE(1)=I CODE ( 1 ) + 1 

0126 

ICODE (2>=0 
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0127 

I CODE (3)=I02T81 

0128 

I CODE (4)=LE0P 

0129 

CALL  URLOOP (11  ST  > 

0130 

T 1 =SECNDS ( 0 . ) 

0131 

90 

I=M0D(DEVST<3> ,2) 

0132 

IF  <1  .EQ.  1)  GOTO  120 

0134 

IF  <1  .EQ.  -1)  GOTO  120 

0136 

DO  110  1=1.10 

0137 

110 

CONTINUE 

0138 

DELTA=SECNDS(T1 > 

0139 

IF  (DELTA  .GE.  20.)  GOTO  150 

0141 

GOTO  90 

0142 

120 

DO  131  J=1 » 129 

0143 

DO  141  1=1,3 

0144 

141 

CONTINUE 

0145 

K=DEVST ( 1 ) 

0146 

131 

CONTINUE 

0147 

DEVST (5)=0 

0148 

ICODE ( 4 ) =IB 

0149 

ICODE ( 5 ) = ID 

0150 

ICODE  < 6 > =LE0P 

0151 

GOTO  160 

0152 

150 

ICODE ( 4 ) =NO 

0153 

ICODE  < 5 ) = IB 

0154 

IC0DE(6)=ID 

0155 

ICODE ( 7 ) =LEOP 

0156 

160 

ICODE ( 1 > =0 

0157 

ICODE (2 ) =0 

0158 

ICODE ( 3 > = ITSV 

0159 

CALL  URLOOP (1 1ST) 

0160 

IF  ( ICODE ( 4 ) .EQ.  IB)  GOTO  170 

0162 

IST=1 

0163 

GOTO  25 

0164 

170 

NRCNO= 1 4 

0165 

N0REC=1 

0166 

IST=7 

0167 

GOTO  12 

0168 

57 

ICODE (3)=I82T81 

0169 

CALL  URLOOP (1 1ST) 

0170 

ICODE ( 1 ) =ICVA 

0171 

ICODE ( 5 ) =LEOP 

0172 

ICODE (2) =1 6 

0173 

ICODE ( 4 ) =81 

0174 

I CODE  < 3 ) = IHH1 

0175 

CALL  URLOOP  <11  ST ) 

0176 

ICODE ( 3 >=5+ 1 SHFT (5,8) 

0177 

CALL  URLOOP (1 1ST) 

0178 

ICODE ( 4 ) =82 

0179 

CALL  URLOOP (1 1ST) 

0180 

ICODE  < 3 ) = IHH1 

0181 

CALL  URLOOP (11  ST ) 

0182 

ICODE ( 3 > = ITSV 

0183 

ICODE  < 1 ) = ICODE ( 1 ) + 1 

0184 

ICODE(2)=0 

0185 

NR=  < ND-1 ) *6  + 121+6 

0186 

341 

READ  < 2 ' NR ) ( RLNE (I), 1 = 1, 20 ) 
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DO  342  LL  = 1 * 20 

342  IF  (RLNE(LL)  .EQ.  0)  RLNE ( LL ) =RSPC 
RLNE<  1 )-RGF'C 
Rl.NE  ( 2 > =RSF'C 

WRITE  < 2 ' NR ) ( RLNE ( I ) r 1 = 1 »20) 

IF  < NFC  .EQ.  151)  GOTO  52 
NR=(ND0-1 >*6+121+6 
GOTO  341 
58  GOTO  53 

700  I CODE ( 4 ) =1 AND (LSKfIC0DE(4>) 

IF  < I CODE ( 4 ) .NE.  LSK ) GOTO  800 
ICODE ( 1 ) =ICODE ( 1 ) + 1 
ICODE ( 2 ) =0 
ICODE (3)=I82T81 
ICODE <4 ) =LEOF' 

CALI.  WRL00P<I1ST) 

GOTO  25 

800  DO  810  J=4  r 1 20 
KKK-J 

ILM=IAND(MSKf ICODE(J) > 

ILL=IAND<LSNf ICODE(J) ) 

IF  (ILM  .EQ.  HSK)  GOTO  820 
810  IF  (ILL  .EQ.  LSK)  GOTO  030 
820  ICODE  < KKK  > = I AND  ( LSK » ICODE  ( KKK' ) > 

GOTO  840 
830  KKK*KKK— 1 

840  URITE( 1 ,20) < ICODEC J) f J=4 t KKK) 

20  FORMAT ( IX. 39A2/1 X f 39A2/1 X f 39A2/ > 

GOTO  25 
12  CONTINUE 

IF  ( NRCNO  .GE.  107)  NRCNO=NRCNO+ 1 
DO  200  J~4  f 1 28 
200  ICODE ( J ) =0 

ICODE ( 127 ) =LEOP 
IF  (NRCNO  .NE.  11)  GOTO  210 
ICODE ( 4 ) =LHOME 
DO  220  J=5,16 
220  ICODE (J)=LF 

REAIK  8 ' 1 1 ) ( ICODE (I)fI=17f  56 ) 

ICODE ( 57 ) =LHOME 
ICODE  ( 5R ) =LEOF' 

CALL  WR1.00P ( 1 1 ST ) 

GOTO  330 
210  NWRTS=4 

IF  (NOREC  .LE.  3)  NURTS=1 
IF  (NOREC  .GE.  4 .AND.  NOREC  .LE.  6)  NURTS=2 
IF  (NOREC  .GE.  7 .AND.  NOREC  .LE.  9)  NWRTS=3 
NN=NRCNO 

DO  310  J--1fNWRTS 
JJJ-J 

DO  450  K=4 f 1 26 
450  ICODE (K)=0 

IF  (J  ,EQ.  1)  ICODE (4>=LFF4 
IF  (J  , FQ.  1)  ICODE ( 5 ) =LFF5 
READ ( 3 ' NN . ERR=500 > ( ICODE ( I > f I~6  f 45) 
N1=(J-1)*3+1 
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0255  IF  < NOREC  .LE.  Nl>  GOTO  250 

0257  NN=NN+1 

0258  READ < 3 ' NN , ERR=500  > ( I CODE ( I ) 1 1=46 . 85  > 

0259  N2=N1+1 

•0260  IF  (NOREC  .LE.  N2>  GOTO  250 

0262  NN=NN+1 

0263  READ ( 3 ' NN , ERR=500 ) ( I CODE  < I ) , I =86 . 1 25  > 

0264  NN=NN+1 

0265  250  I CODE <45)  = ICRLF 

0266  I CODE ( 85 ) =ICRLF 

0267  IC0DE(125)=ICRLF 

0268  ICODE( 126)=IDC1 

0269  IF  (J  .EC1.  NURTS)  ICODE ( 126)=LH0ME 

0271  CALL  WRLOOP ( I 1ST > 

0272  I1ST=1 

0273  310  CONTINUE 

0274  330  CONTINUE 

0275  DO  70  J=l. NOREC 

0276  NOR=NRCNO+ J-l 

0277  READ ( 3 ' NOR ) ( MOUT  <I»J)»I  = 1»10) 

0278  70  WRITE ( 1 r 15 > ( MOUT (I.J)>I  = 1>10) 

0279  DO  80  J=l*ll 

0280  DO  80  1=1.10 

0281  80  MOUT ( I . J ) =0 

0282  500  CONTINUE 

0283  IF  (1ST  .NE.  9999)  GOTO  25 

0285  END 

> 


1.7  Diagnostics 


1.7.1  PDP-11  Interface  (PDP) 

This  diagnostic  program  checks  the  M1710  PDP-11  interface  and  the 
Host  Interface  Board.  The  diagnostic  runs  on  the  host  machine 
to  be  tested  and  the  microcode  object  file  PDPOoOBJ  runs  on  the  B7* 
CIE  microprocessor  connected  to  that  host.  The  source  (.FOR), 
object  (.OBJ),  and  the  task  (.TSK)  files  reside  on  ESM  Tape  #4. 

The  program  uses  terminal  TTO:  for  I/O.  A timing  parameter  is 
requested  which  is  entered  in  13  format,  and  which  must  be  greater 
or  equal  to  3.  This  timing  parameter  controls  the  rate  at  which 
words  are  sent  across  the  interface.  The  program  then  provides  a 
time  for  packet  transmission  printout.  A three  line  packet  can 
then  be  entered  on  the  terminal.  Proper  interface  operation  results 
in  the  message  being  printed  on  the  terminal  after  the  CIE  program 
is  run  from  location  WRTB  (see  PDPO  description  in  Section  2.3). 

Task  Builder  (TKB)  options  are: 

UNITS=1 
ACTFIL=1 
MAXBUF=80 
COMMON=M1710 :RW 
ASG=TTO: 1 


1.7o2  Control  Memory  - CONMEM 

ESM  Tape  #4  contains  the  source  (.FOR),  object  (.OBJ),  and  task 
(.TSK)  files  for  the  control  memory  checking  program  (CONMEM). 

The  program  is  a variation  of  the  ESMLDR  utility  described  in 
Section  1.4  in  which  a halt  is  inserted  at  the  last  word  of  control 
memory.  The  program  is  useful  in  debugging  certain  types  of 
control  memory  and  loading  problems. 
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c 

DIAG  PROG  FOR  CKING  M1710-CIE  INT 

0001 

INTEGER  DEVST  < 6 ) 

0002 

COMMON  /Ml 71 0/PEVST 

0003 

DIMENSION  ICODE ( 128 ) 

0004 

CALL  ASSIGNLl. 'TTO: ' ) 

0005 

NT=70 

D 

WRITE ( 1 , 300 ) 

D 

300 

FORMAT (IX,' ENTER  TIM  PAR') 

D 

READ (1.310)  NT 

D 

310 

FORMAT (13) 

C 

THROW  AWAY  PACKET  FOR  INP  BUF  INIT  EMPTY 

0006 

DO  130  J=1 » 129 

0007 

DO  140  1=1. NT 

0008 

140 

CONTINUE 

0009 

130 

K=DEVST(1> 

0010 

150 

READ (1.30) (ICODE (I >.1=1.40) 

0011 

READ (1.30) (ICODE (I >,1=41.80) 

0012 

READ (1,30) (ICODE (I). 1=8 1,1 20) 

0013 

30 

FORMAT (40A2) 

D 

T1=SECNDS(0. ) 

0014 

DO  70  J=1 , 1 28 

0015 

DO  80  1=1, NT 

0016 

80 

CONTINUE 

0017 

70 

DEVST (2)=IC0PE(J> 

0018 

DEVST ( 6 ) =0 

D 

DELTA=SECNDS ( T 1 ) 

D 

WRITE ( 1 .400 ) DELTA 

D 

400 

FORMAT (IX, ' DELTA= ' , F9 • 5 ) 

0019 

DEVST ( 5 > =0 

0020 

90 

I=MOD(DEVST (3) ,2) 

0021 

IF  (I  ,E0.  1)  GOTO  120 

0023 

IF  (I  .EO.  -1)  GOTO  120 

0025 

DO  110  J=1 » 200 

0026 

110 

CONTINUE 

0027 

GOTO  90 

0028 

120 

DO  230  J= 1 , 1 29 

0029 

DO  240  1=1, NT 

0030 

o 

5T 

CM 

CONTINUE 

0031 

IF  (J  .EO.  1)  K=DEVST ( 1 ) 

0033 

IF  (J  .GT.  1)  I CODE ( J-l ) =DEVST ( 1 > 

0035 

230 

CONTINUE 

0036 

WRITE ( 1.160) (ICODE (I >,1=1,39) 

0037 

WRITE (1.160) (ICODE (I), 1=4 1,79) 

0038 

WRITE (1.160) (ICODE (I), 1=81. 119) 

0039 

160 

FORMAT (1X.39A2/) 

0040 

GOTO  150 

0041 

> 

END 

1 
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0001 

0002 

0003 

0004 

0005 

0006 

0007 

0008 

0009 

0010 
0011 
0012 

0013 

0014 

0015 

0016 
0017 
0013 

0019 

0020 
0022 

0023 

0024 

0025 

0026 

0027 

0028 
002? 

0030 

0031 

0032 

0033 

0034 

0035 

0036 

0037 

0038 

0039 

0040 

0041 

0042 


INTEGER  DEVST (6) .CODEC 128) 

REAL*8  ZA  < 3 ) 

COMMON  /M1710/DEVST 
DATA  ISTEP/-607/ 

DATA  IA0N/* 177777/ 

DATA  IER1 » IER2/ " 363, * 7776/ 

CALL  ASSIGNC1,  'TT1 : ') 

WRITE< 1 t 1 1 ) 

11  FORMAT ( 1X» 'PLEASE  ENTER  OBJECT  FILE  NAME') 

READdf  12)ZA 

12  FORMAT < 3A8 ) 

CALL  ASSIGN C 2 . ZA ) 

DEFINE  FILE  2< 32. 12B.U. II > 

DO  20  NREC=1 f 32 
NR=NREC 

READ<  2 ' NREC t END=99 » ERR=99 ) CODE 
DO  18  J=1 » 128 
DO  16  KK=1 t 5 
16  CONTINUE 

IF  (CODE(J)  ,E0.  IAON > C0DE< J)  = ISTEP 

DEVST (2) =CODE ( J) 

18  CONTINUE 

WRITE  (1.13)  NREC 

13  FORMAT C IX. 13 » ' 128  INSTRUCTION  GROUPS  LOADED.') 

20  CONTINUE 
9?  DO  30  J=1 r 128 
30  CODEC J)=ISTEP 
DO  40  N=NR  r 31 
DO  40  J=lrl2B 
DO  50  KK=lr5 
50  CONTINUE 

DEVST ( 2 ) =CODE  C J > 

40  CONTINUE 

CODE ( 126 )=IER1 
CODEC 127)=IER2 
DO  60  J=1 » 127 
DO  70  KK=1.5 
70  CONTINUE 

DEVST ( 2 ) =CODt ( J ) 

60  CONTINUE 
END 
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